home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / node2src.zip / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1990-11-07  |  89KB  |  2,694 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS CPC17.3, Copyright 1986-90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  First Released .....: February 4, 1990
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986-1990
  8. '  Purpose.............:
  9. '     Subprorams that require error trapping are incorporated
  10. '     within RBBSSUB1.BAS as separately callable subroutines
  11. '     in order to free up as much code as possible within
  12. '     the 64WasK code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  ChangeDir   20101   Change subdirectory
  18. '  CheckInt    58360   Check input is valid integer
  19. '  CommPut     59275   Write string to communications port
  20. '  FileLock    21993 Allow files to be shared among multiple RBBS-PC's 'Pe 02/04/90
  21. '  FindFile    59790   Determine whether a file exists without opening it ' AC012601
  22. '  FindFree    51098   Find amount of space on the upload disk drive
  23. '  FindItX     20219   Find if a file exists on a device             ' KG061001
  24. '  FindUser    12598   Find a user in the USERS file
  25. '  FlushCom    20308   Read all characters in the communications port
  26. '  GetCom       1418   Read a character from the communications port
  27. '  GetPassword 58280   Read RBBS-PC's "PASSWORD" file
  28. '  GETWRK      58330   Read record from file number 2
  29. '  KillWork    58258   Delete a RBBS-PC "WORK" file
  30. '  NetBIOS     20898   Lock/Unlock NetBIOS semaphore files
  31. '  OpenCom       200   Open communications port (number 3)
  32. '  OpenFMS     58188   Open the upload management system directory
  33. '  OpenOutW    28218   Open RBBS-PC's "WORK" file (number 2) for output
  34. '  OpenRSeq     1479   Open a sequential file (number 2) for random I/O
  35. '  OpenUser     9398   Open the USER file (number 5)
  36. '  OpenWork    57978   Open RBBS-PC's work file (number 2)
  37. '  OpenWorkA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  38. '  Printit     13673   Print line on the local PC printer
  39. '  PrintWork   58320   Print string to file #2 w/o CR/LF
  40. '  PrintWorkA  58350   Print string to file #2 with CR/LF
  41. '  PutCom      59650   Write to the communications port
  42. '  PutWork     59660   Write to work file randomly
  43. '  RBBSPlay    59680   Plays a musical string
  44. '  ReadAny     58310   Read file number 2 into ZOutTxt$
  45. '  ReadDef       112   Read configuration file
  46. '  ReadDir     58290   Read entire lines
  47. '  ReadParms   58300   Read certain number of parameters from file 2
  48. '  Talk        59700   RBBS-PC Voice synthesizer support for sight impaired
  49. '  SetCall       108   Find where next callers record is
  50. '  UpdateC     43048   Update the caller's file with elasped session time
  51. '  UpdtCalr    13661   Update to the caller's file
  52. '  ViewTxt     60140   Display ASCII file from Compressed file 'Pe 02/03/90
  53. '
  54. '  $INCLUDE: 'RBBS-VAR.BAS'
  55. '
  56. 108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
  57. ' $PAGE
  58. '
  59. '  NAME    -- SetCall
  60. '
  61. '  INPUTS  --     PARAMETER                    MEANING
  62. '
  63. '  OUTPUTS --  ZCallersFileIndex!
  64. '
  65. '  PURPOSE --  To find where to leave off on callers file
  66. '
  67.     SUB SetCall STATIC
  68.     ON ERROR GOTO 65000
  69.     IF PrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _
  70.        EXIT SUB
  71.     PrevCaller$ = ZCallersFile$
  72.     ZCallersFileIndex! = 1
  73.     CLOSE 2
  74.     CLOSE 4
  75.     IF ZShareIt THEN _
  76.        OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  77.     ELSE OPEN "R",4,ZCallersFile$,64
  78.     FIELD 4,64 AS ZCallersRecord$
  79.     IF LOF(4) > 0 THEN _
  80.        ZCallersFileIndex! = LOF(4) / 64
  81.     IF ZCallersFileIndex! < 1 THEN _
  82.        ZCallersFileIndex! = 0
  83.     ZUserIn$ = STRING$(13,0)
  84. 110 GET 4,ZCallersFileIndex!
  85.     IF ZErrCode > 0 THEN _
  86.        ZErrCode = 0 : _
  87.        ZCallersFileIndex! = 0 : _
  88.        EXIT SUB
  89.     IF LEFT$(ZCallersRecord$,13) = ZUserIn$ THEN _
  90.        ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  91.        GOTO 110
  92.     END SUB
  93.  
  94. 112 ' $SUBTITLE: 'ReadDef - subroutine to read RBBS-PC.DEF file'
  95. ' $PAGE
  96. '
  97. '  NAME    -- ReadDef
  98. '
  99. '  INPUTS  --     PARAMETER                    MEANING
  100. '                ZConfigFileName$            NAME OF RBBS-PC.DEF FILE
  101. '                ZSubParm = -62              ONLY READ THE .DEF FILE
  102. '
  103. '  OUTPUTS --  ALL THE RBBS-PC.DEF PARAMETERS
  104. '
  105. '  PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  106. '
  107.      SUB ReadDef (ConfigFile$) STATIC
  108.      ON ERROR GOTO 65000
  109. '
  110. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
  111. '
  112. 117 IF ZSubParm <> -62 THEN _
  113.        IF PrevRead$ = ConfigFile$ THEN _
  114.           EXIT SUB _
  115.        ELSE PrevRead$ = ConfigFile$
  116.     CLOSE 2
  117.     ZBulletinSave$ = ZBulletinMenu$
  118.     CALL OpenWork (2,ConfigFile$)
  119.     ZCurDef$ = ConfigFile$
  120.     INPUT #2,ZWasDF$, _
  121.              ZDnldDrives$, _
  122.              ZSysopPswd1$, _
  123.              ZSysopPswd2$, _
  124.              ZSysopFirstName$, _
  125.              ZSysopLastName$, _
  126.              ZRequiredRings, _
  127.              ZStartOfficeHours, _
  128.              ZEndOfficeHours, _
  129.              ZMinsPerSession, _                                      ' DA111103
  130.              ZWasDF, _
  131.              ZWasDF, _
  132.              ZUpldDir$, _
  133.              ZExpertUserDef, _
  134.              ZActiveBulletins, _
  135.              ZPromptBellDef, _
  136.              ZWasDF, _
  137.              ZMenusCanPause, _
  138.              ZMenu$(1), _
  139.              ZMenu$(2), _
  140.              ZMenu$(3), _
  141.              ZMenu$(4), _
  142.              ZMenu$(5), _
  143.              ZMenu$(6), _
  144.              ZConfMenu$, _
  145.              ZWasDF, _
  146.              ZWelcomeInterruptable, _
  147.              ZRemindFileXfers, _
  148.              ZPageLengthDef, _                                       ' KG080801
  149.              ZMaxMsgLinesDef, _
  150.              ZDoorsAvail, _
  151.              ZWasDF$, _
  152.              ZMainMsgFile$, _
  153.              ZMainMsgBackup$
  154.     INPUT #2, WasX$, _
  155.               ZCmntsFile$, _
  156.               ZMainUserFile$, _
  157.               ZWelcomeFile$, _
  158.               ZNewUserFile$, _
  159.               ZMainDirExtension$
  160.     CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
  161.     IF ZWasDF$ <> "" THEN _                                          ' RB060403
  162.        ZCallersFile$ = WasX$
  163.     INPUT #2, ZWasDF$
  164.     IF ZComPort$ <> "COM0" THEN _
  165.        IF NOT ZConfMode THEN _
  166.           ZComPort$ = ZWasDF$
  167.     INPUT #2, ZBulletinsOptional, _
  168.               ZModemInitCmd$, _
  169.               ZRTS$, _
  170.               ZWasDF, _
  171.               ZFG, _
  172.               ZBG, _
  173.               ZBorder
  174.     IF ZConfMode THEN _
  175.        INPUT #2, ZWasDF$, _
  176.                  ZWasDF$ _
  177.     ELSE INPUT #2, ZRBBSBat$ , _
  178.                    ZRCTTYBat$
  179.     INPUT #2,ZOmitMainDir$, _
  180.              ZFirstNamePrompt$, _
  181.              ZHelp$(3), _
  182.              ZHelp$(4), _
  183.              ZHelp$(7), _
  184.              ZHelp$(9), _
  185.              ZBulletinMenu$, _
  186.              ZBulletinPrefix$, _
  187.              ZWasDF$, _
  188.              ZMsgReminder, _
  189.              ZRequireNonASCII, _
  190.              ZAskExtendedDesc, _
  191.              ZMaxNodes, _
  192.              ZNetworkType                                            ' JM122202
  193.     IF ZConfMode THEN _                                              ' JM122202
  194.          INPUT #2, ZwasDF _                                          ' JM122202
  195.     ELSE INPUT #2, ZRecycleToDos                                     ' JM122202
  196.     INPUT #2,ZWasDF, _                                               ' JM122202
  197.              ZWasDF, _
  198.              ZTrashcanFile$
  199.     INPUT #2,ZMinLogonSec, _
  200.              ZDefaultSecLevel, _                                     ' KG020901
  201.              ZSysopSecLevel, _
  202.              ZFileSecFile$, _
  203.              ZSysopMenuSecLevel, _
  204.              ZConfMailList$, _
  205.              ZMaxViolations, _
  206.              ZOptSec(50), _   ' SECURITY FOR Sysop COMMANDS 1
  207.              ZOptSec(51), _
  208.              ZOptSec(52), _
  209.              ZOptSec(53), _
  210.              ZOptSec(54), _
  211.              ZOptSec(55), _
  212.              ZOptSec(56), _   ' ZSysop 7
  213.              ZPswdFile$, _
  214.              ZMaxPswdChanges, _
  215.              ZMinSecForTempPswd, _
  216.              ZOverWriteSecLevel, _
  217.              ZDoorsTermType, _
  218.              ZMaxPerDay
  219.     INPUT #2,ZOptSec(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  220.              ZOptSec(2), _
  221.              ZOptSec(3), _
  222.              ZOptSec(4), _
  223.              ZOptSec(5), _
  224.              ZOptSec(6), _
  225.              ZOptSec(7), _
  226.              ZOptSec(8), _
  227.              ZOptSec(9), _
  228.              ZOptSec(10), _
  229.              ZOptSec(11), _
  230.              ZOptSec(12), _
  231.              ZOptSec(13), _
  232.              ZOptSec(14), _
  233.              ZOptSec(15), _
  234.              ZOptSec(16), _
  235.              ZOptSec(17), _
  236.              ZOptSec(18), _   ' MAIN COMMAND 18
  237.              ZMinNewCallerBaud, _
  238.              ZWaitBeforeDisconnect
  239.     INPUT #2,ZOptSec(19), _      ' Security for FILE COMMANDS 1
  240.              ZOptSec(20), _
  241.              ZOptSec(21), _
  242.              ZOptSec(22), _
  243.              ZOptSec(23), _
  244.              ZOptSec(24), _
  245.              ZOptSec(25), _
  246.              ZOptSec(26), _      ' FILE COMMAND 8
  247.              ZOptSec(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  248.              ZOptSec(28), _
  249.              ZOptSec(29), _
  250.              ZOptSec(30), _
  251.              ZOptSec(31), _
  252.              ZOptSec(32), _
  253.              ZOptSec(33), _
  254.              ZOptSec(34), _
  255.              ZOptSec(35), _
  256.              ZOptSec(36), _
  257.              ZOptSec(37), _
  258.              ZOptSec(38), _   ' UTIL COMMAND 12
  259.              ZOptSec(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  260.              ZOptSec(47), _
  261.              ZOptSec(48), _
  262.              ZOptSec(49), _
  263.              ZUpldTimeFactor!, _
  264.              ZComputerType, _
  265.              ZRemindProfile, _
  266.              ZRBBSName$, _
  267.              ZCmdsBetweenRings, _
  268.              ZMNPSupport, _
  269.              ZPagingPtrSupport$                                      ' RK122301
  270.     IF ZConfMode THEN _                                              ' RK122301
  271.          INPUT #2, ZwasDF _                                          ' RK122301
  272.     ELSE INPUT #2, ZModemInitBaud$                                   ' RK122301
  273.              IF ZErrCode > 0 THEN _
  274.                 EXIT SUB
  275. 118 INPUT #2, ZTurnPrinterOff,_    ' Turn printer off each recycle
  276.               ZDirPath$, _    ' Where dir files are stored
  277.               ZMinSecToView, _
  278.               ZLimitSearchToFMS, _
  279.               ZDefaultCatCode$, _
  280.               ZDirCatFile$, _
  281.               ZNewFilesCheck, _
  282.               ZMaxDescLen, _
  283.               ZShowSection, _
  284.               ZCmndsInPrompt, _
  285.               ZNewUserSetsDefaults, _
  286.               ZHelpPath$, _
  287.               ZHelpExtension$, _
  288.               ZMainCmds$, _
  289.               ZFileCmd$, _
  290.               ZUtilCmds$, _
  291.               ZGlobalCmnds$, _
  292.               ZSysopCmds$
  293.     INPUT #2, ZRecycleWait, _
  294.               ZOptSec(39), _       ' SECURITY FOR Library COMMANDS 1
  295.               ZOptSec(40), _
  296.               ZOptSec(41), _
  297.               ZOptSec(42), _
  298.               ZOptSec(43), _
  299.               ZOptSec(44), _
  300.               ZOptSec(45), _       ' Library COMMANDS 7
  301.               ZLibDrive$, _
  302.               ZLibDirPath$, _
  303.               ZLibDirExtension$, _
  304.               ZLibWorkDiskPath$, _
  305.               ZLibMaxDisk, _
  306.               ZLibMaxDir, _
  307.               ZLibMaxSubdir, _
  308.               ZLibSubdirPrefix$, _
  309.               ZLibArcPath$, _
  310.               ZLibArcProgram$, _
  311.               ZLibCmds$
  312. '
  313. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ***
  314. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ***
  315. '
  316.     INPUT #2, ZUpldPath$, _              ' Where upl dir goes
  317.               ZMainFMSDir$, _       ' Shared dir in FMS
  318.               ZAnsMenu$, _
  319.               ZReqQues$,_
  320.               ZRememberNewUsers,_
  321.               ZSurviveNoUserRoom,_
  322.               ZPromptHash$,_
  323.               ZStartHash,_
  324.               ZLenHash,_
  325.               ZPromptIndiv$,_
  326.               ZStartIndiv,_
  327.               ZLenIndiv
  328.     INPUT #2, ZBypassMsgs, _
  329.               ZMusic, _
  330.               ZRestrictByDate, _
  331.               ZDaysToWarn, _
  332.               ZDaysInRegPeriod, _
  333.               ZVoiceType, _
  334.               ZRestrictValidCmds, _
  335.               ZNewUserDefaultMode, _
  336.               ZNewUserLineFeeds, _
  337.               ZArkViewPath$, _             'Pe 02/04/90
  338.               ZFastFileList$, _                                      ' KG102201
  339.               ZFastFileLocator$, _                                   ' KG102201
  340.               ZMsgsCanGrow, _
  341.               ZWrapCallersFile$, _
  342.               ZRedirectIOMethod, _
  343.               ZAutoUpgradeSec, _
  344.               ZHaltOnError, _
  345.               ZNewPublicMsgsSec, _
  346.               ZNewPrivateMsgsSec, _
  347.               SecNeededToChangeMsgs, _
  348.               ZSLCategorizeUplds, _
  349.               ZBaudot, _
  350.               ZHourMinToDropToDos, _
  351.               ZExpiredSec, _
  352.               ZDTRDropDelay, _
  353.               ZAskID, _
  354.               ZMaxRegSec, _
  355.               ZBufferSize, _
  356.               ZMLCom, _
  357.               ZNoDoorProtect, _
  358.               ZDefaultExtension$, _
  359.               ZNewUserDefaultProtocol$, _
  360.               ZNewUserGraphics$, _
  361.               ZNetMail$, _
  362.               ZMasterDirName$, _
  363.               ZProtoDef$, _
  364.               ZUpcatHelp$, _
  365.               ZAllwaysStrewTo$, _
  366.               ZLastNamePrompt$
  367. 119 INPUT #2, ZPersonalDrvPath$, _
  368.               ZPersonalDir$, _
  369.               ZPersonalBegin, _
  370.               ZPersonalLen, _
  371.               ZPersonalProtocol$, _
  372.               ZPersonalConcat , _
  373.               ZPrivateReadSec, _
  374.               ZPublicReadSec, _
  375.               ZSecChangeMsg                                          ' RK122301
  376.     IF ZConfMode THEN _                                              ' RK122301
  377.          INPUT #2, ZwasDF _                                          ' RK122301
  378.     ELSE INPUT #2, ZKeepInitBaud                                     ' RK122301
  379.     INPUT #2, ZMainPUI$                                              ' RK122301
  380.     IF ZConfMode THEN _
  381.        INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
  382.     ELSE INPUT #2, ZDefaultEchoer$, _
  383.                    ZHostEchoOn$, _
  384.                    ZHostEchoOff$
  385.     INPUT #2, ZSwitchBack, _
  386.               ZDefaultLineACK$, _
  387.               ZAltdirExtension$, _
  388.               ZDirPrefix$
  389.     IF ZConfMode THEN _
  390.        INPUT #2, ZWasDF, _
  391.                  ZWasDF, _
  392.                  ZWasDF _
  393.     ELSE INPUT #2, ZWasDF,_
  394.                    ZModemInitWaitTime, _
  395.                    ZModemCmdDelayTime
  396.     INPUT #2, ZTurboRBBS, _
  397.               ZSubDirCount, _
  398.               ZWasDF, _
  399.               ZUpldToSubdir, _
  400.               ZWasDF, _
  401.               ZUpldSubdir$, _
  402.               ZMinOldCallerBaud, _
  403.               ZMaxWorkVar, _
  404.               ZDiskFullGoOffline, _
  405.               ZExtendedLogging
  406.      IF ZConfMode THEN _
  407.         INPUT #2, ZWasDF$, _
  408.                   ZWasDF$, _
  409.                   ZWasDF$, _
  410.                   ZWasDF$ _
  411.      ELSE INPUT #2, ZModemResetCmd$, _
  412.                     ZModemCountRingsCmd$, _
  413.                     ZModemAnswerCmd$, _
  414.                     ZModemGoOffHookCmd$
  415.      INPUT #2,ZDiskForDos$, _
  416.               ZDumbModem, _
  417.               ZCmntsAsMsgs
  418.      IF ZConfMode THEN _
  419.         INPUT #2, ZWasDF, _
  420.                   ZWasDF, _
  421.                   ZWasDF, _
  422.                   ZWasDF, _
  423.                   ZWasDF, _
  424.                   ZWasDF _
  425.      ELSE INPUT #2, ZLSB,_
  426.                     ZMSB,_
  427.                     ZLineCntlReg,_
  428.                     ZModemCntlReg,_
  429.                     ZLineStatusReg,_
  430.                     ZModemStatusReg
  431.      INPUT #2,ZKeepTimeCredits, _
  432.               ZXOnXOff, _
  433.               ZAllowCallerTurbo, _
  434.               ZUseDeviceDriver$, _
  435.               ZPreLog$, _
  436.               ZNewUserQuestionnaire$, _
  437.               ZEpilog$, _
  438.               ZRegProgram$, _
  439.               ZQuesPath$, _
  440.               ZUserLocation$, _
  441.               ZWasDF$, _
  442.               ZWasDF$, _
  443.               ZWasDF$, _
  444.               ZEnforceRatios, _
  445.               ZSizeOfStack, _
  446.               ZSecExemptFromEpilog, _
  447.               ZUseBASICWrites, _
  448.               ZDosANSI, _
  449.               ZEscapeInsecure, _
  450.               ZUseDirOrder, _
  451.               ZAddDirSecurity, _
  452.               ZMaxExtendedLines, _
  453.               ZOrigCommands$
  454.      INPUT #2,ZLogonMailLevel$, _
  455.               ZMacroDrvPath$, _
  456.               ZMacroExtension$, _
  457.               ZEmphasizeOnDef$, _
  458.               ZEmphasizeOffDef$, _
  459.               ZFG1Def$, _
  460.               ZFG2Def$, _
  461.               ZFG3Def$, _
  462.               ZFG4Def$, _
  463.               ZSecVioHelp$
  464.      IF ZConfMode THEN _
  465.         INPUT #2,ZWasDF _
  466.      ELSE INPUT #2,ZFossil
  467.      INPUT #2,ZMaxCarrierWait, _
  468.               ZWasDF, _
  469.               ZSmartTextCode, _
  470.               ZTimeLock, _
  471.               ZWriteBufDef, _
  472.               ZSecKillAny, _
  473.               ZDoorsDef$, _
  474.               ZScreenOutMsg$, _
  475.               ZAutoPageDef$
  476.      IF ZErrCode > 0 THEN _
  477.         EXIT SUB
  478.      ZConfigFileName$ = ConfigFile$
  479. '     CALL UnString(ZEmphasizeOnDef$,";40")     'ANSIEd   ' Bh 110790
  480. '     CALL UnString(ZEmphasizeOffDef$,";40")    '
  481. '     CALL UnString(ZFG1Def$,";40")             '
  482. '     CALL UnString(ZFG2Def$,";40")             '
  483. '     CALL UnString(ZFG3Def$,";40")             '
  484. '     CALL UnString(ZFG4Def$,";40")             '
  485.      CALL EditDef
  486.      END SUB
  487. 200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
  488. ' $PAGE
  489. '
  490. '  NAME    -- OpenCom
  491. '
  492. '  INPUTS  --     PARAMETER                    MEANING
  493. '                BaudRate$                  BAUD TO OPEN MODEM
  494. '                Parity$                    PARITY TO OPEN MODEM
  495. '
  496. '  OUTPUTS -- BaudTest!                     BAUD RATE TO SET RS232 AT
  497. '
  498. '  PURPOSE -- To open the communications port.
  499. '
  500.     SUB OpenCom (BaudRate$,Parity$) STATIC
  501.     ON ERROR GOTO 65000
  502.     IF INSTR(Parity$,"N") THEN _
  503.        Parity = 2 : _                                     ' No PARITY
  504.        DataBits = 3 : _                                   ' 8 DATA BITS
  505.        StopBits = 0 _                                     ' 1 STOP BIT
  506.     ELSE Parity = 3 : _                                   ' EVEN PARITY
  507.          DataBits = 2 : _                                 ' 7 DATA BITS
  508.          StopBits = 0                                     ' 1 STOP BIT
  509. 202 CLOSE 3                                                          ' RK010401
  510.     IF ZRTS$ = "YES" THEN _
  511.        ZFlowControl = ZTrue : _
  512.        WasX$ = ",CS26600,CD,DS" _
  513.     ELSE WasX$ = ",RS,CD,DS"
  514.     WasX = (VAL(BaudRate$) > 19200)                                  ' KG092503
  515.     IF WasX THEN _                                                   ' KG092503
  516.        ZWasY$ = "19200" _                                            ' KG092503
  517.     ELSE ZWasY$ = BaudRate$                                          ' KG092503
  518.     OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3            ' KG092503
  519. '
  520. ' ****************************************************************************
  521. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
  522. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
  523. ' ****************************************************************************
  524. '
  525.     END SUB
  526. 1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from  comm. port'
  527. ' $PAGE
  528. '
  529. '  NAME    -- GetCom
  530. '
  531. '  INPUTS  --   PARAMETER     MEANING
  532. '                 Strng$       STRING TO READ A CHARACTER INTO FROM
  533. '                              THE COMMUNICATIONS PORT (FILE #3)
  534. '
  535. '  OUTPUTS --   Strng$
  536. '
  537. '  PURPOSE -- Reads a character from the communications port.
  538. '
  539.      SUB GetCom (Strng$) STATIC
  540.      ON ERROR GOTO 65000
  541. 1420 Strng$ = INPUT$(1,3)
  542. 1421 IF ZErrCode = 57 THEN _
  543.         LineStatus = INP(ZLineStatusReg) : _
  544.         ZErrCode = 0 : _
  545.         GOTO 1420
  546.      END SUB
  547. 1479 ' $SUBTITLE: 'OpenRSeq  - open sequential file randomly'
  548. ' $PAGE
  549. '
  550. '  NAME    -- OpenRSeq
  551. '
  552. '  INPUTS  -- PARAMETER             MEANING
  553. '             FilName$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  554. '
  555. '  OUTPUTS -- NumRecs      NUMBER OF 128-BYTE RECORDS IN THE FILE
  556. '             LenLastRec   NUMBER OF BYTES IN THE LAST RECORD (IT
  557. '                          MAY BE LESS THAN OR EQUAL TO 128).
  558. '
  559. '  PURPOSE -- Open a sequential file as file #2 and read it randomly
  560. '
  561.      SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
  562.      ON ERROR GOTO 65000
  563.      CLOSE 2
  564. 1480 ZErrCode = 0
  565. 1481 IF ZShareIt THEN _
  566.         OPEN FilName$ FOR RANDOM SHARED AS #2 LEN=RecLen _
  567.      ELSE OPEN "R",2,FilName$,RecLen
  568.      IF ZErrCode = 52 THEN _
  569.         GOTO 1480
  570.      FIELD #2, RecLen AS ZDnldRecord$
  571.      WasI# = LOF(2)
  572.      NumRecs = FIX(WasI#/RecLen)
  573.      LenLastRec = WasI# - CDBL(NumRecs) * RecLen
  574.      IF LenLastRec > 0 THEN _
  575.         NumRecs = NumRecs + 1 _
  576.      ELSE LenLastRec = RecLen
  577.      END SUB
  578. 9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
  579. ' $PAGE
  580. '
  581. '  NAME    -- OpenUser
  582. '
  583. '  INPUTS  --     PARAMETER                    MEANING
  584. '                 ZShareIt
  585. '
  586. '  OUTPUTS -- ZActiveUserFile$
  587. '             ZCityState$
  588. '             ZElapsedTime$
  589. '             ZLastDateTimeOn$
  590. '             LastRec                # OF Last RECORD IN USERS FILE
  591. '             ZListNewDate$
  592. '             ZPswd$
  593. '             ZSecLevel$
  594. '             ZUserDnlds$
  595. '             ZUserName$
  596. '             ZUserOption$
  597. '             ZUserRecord$
  598. '             ZUserUplds$
  599. '
  600. '  PURPOSE -- Open the user file as file #5
  601. '
  602.       SUB OpenUser (LastRec) STATIC
  603.       ON ERROR GOTO 65000
  604. '
  605. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****
  606. '
  607. 9400 CLOSE 5
  608.      IF ZShareIt THEN _
  609.         OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
  610.      ELSE OPEN "R",5,ZActiveUserFile$,128
  611.      WasI# = LOF(5)
  612.      LastRec = FIX(WasI#/128)
  613.      FIELD 5,31 AS ZUserName$, _
  614.              15 AS ZPswd$, _
  615.               2 AS ZSecLevel$, _
  616.              14 AS ZUserOption$,  _
  617.              24 AS ZCityState$, _
  618.               2 AS MachineType$, _
  619.               1 AS ZBankTime$,_                        'SRK030690
  620.               4 AS ZTodayDl$, _
  621.               4 AS ZTodayBytes$, _
  622.               4 AS ZDlBytes$, _
  623.               4 AS ZULBytes$, _
  624.              14 AS ZLastDateTimeOn$, _
  625.               3 AS ZListNewDate$, _
  626.               2 AS ZUserDnlds$, _
  627.               2 AS ZUserUplds$, _
  628.               2 AS ZElapsedTime$
  629.      FIELD 5,128 AS ZUserRecord$
  630.      END SUB
  631. 12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
  632. ' $PAGE
  633. '
  634. '  NAME    -- FindUser
  635. '
  636. '  INPUTS  --     PARAMETER                    MEANING
  637. '             HashToLookFor$        STRING TO SEARCH FOR IN USERS
  638. '             IndivToLookFor$       STRING TO USE TO INDIVIDUATE
  639. '                                   USERS WITH SAME HASH
  640. '             StartHashPos          WHERE HASH FIELD STARTS IN THE
  641. '                                  "USERS" FILE
  642. '             LenHashField          LENGTH OF THE HASH FIELD
  643. '             StartIndivPos         WHERE THE FIELD TO DISTINGUISH
  644. '                                   AMONG USERS (I.E. WITH THE SAME
  645. '                                   NAME) STARTS IN THE "USERS" FILE
  646. '                                   (SET TO 0 IF NONE TO BE USED)
  647. '             LenIndivField         LENGTH OF FIELD TO DISTINGUISH
  648. '                                   AMONG USERS
  649. '             MaxPosition           HIGHEST RECORD TO SEARCH OR USE
  650. '
  651. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  652. '
  653. '  OUTPUTS -- WhetherFound          SET TO "TRUE" IF USER WAS Found
  654. '                                   OTHERWISE IT IS "FALSE"
  655. '             PosToUse              NUMBER OF THE "USERS" RECORD THAT
  656. '                                   BELONGS TO THE USER (IF Found) OR
  657. '                                   TO USE FOR THE USER (IF THE USER
  658. '                                   WASN'T Found)
  659. '             PosToReclaim          SET TO 0 IF THE RECORD NUMBER
  660. '                                   SELECTED FOR THIS USER HAS NEVER
  661. '                                   BEEN USED.
  662. '
  663. '  PURPOSE -- To search the "USERS" file and determine the record
  664. '             number to use for the caller in the "USERS" file.
  665. '
  666.       SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
  667.                     LenHashField,StartIndivPos,LenIndivField,_
  668.                     MaxPosition,WhetherFound,_
  669.                     PosToUse,PosToReclaim) STATIC
  670.       ON ERROR GOTO 65000
  671.       ZErrCode = 0
  672.       WhetherFound = 0
  673.       IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
  674.          EXIT SUB
  675.       EmptyRec$ = SPACE$(LenHashField)
  676.       EmptyIndiv$ = SPACE$(LenIndivField)
  677.       NewUser$ = LEFT$("NEWUSER  ",LenHashField + 2)
  678.       FIELD 5, 128 AS Filler$
  679.       WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
  680.       CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
  681. 12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
  682.       PosToReclaim = 0
  683. 12610 GET 5,PosToUse
  684.       IF ZErrCode > 0 THEN _
  685.          IF ZErrCode = 63 THEN _
  686.             ZErrCode = 0 : _
  687.             GOTO 12621 _
  688.          ELSE ZErrCode = 0 : _
  689.          GOTO 12620
  690.       HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
  691.       IF WasX$ = HashValue$ THEN _
  692.          IF StartIndivPos < 1 THEN _
  693.            WhetherFound = ZTrue : _
  694.            GOTO 12622 _
  695.          ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
  696.               IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
  697.                  WhetherFound = ZTrue : _
  698.                  GOTO 12622
  699.       IF HashValue$ = EmptyRec$ THEN _
  700.          PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
  701.          WhetherFound = ZFalse : _
  702.          GOTO 12622
  703.       IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
  704.          IF PosToReclaim = 0 THEN _
  705.             PosToReclaim = PosToUse
  706. 12620 PosToUse = PosToUse + ZWasDF
  707.       IF PosToUse > MaxPosition - 1 THEN _
  708.          PosToUse = PosToUse - MaxPosition
  709.       GOTO 12610
  710. 12621 IF PosToReclaim = 0 THEN _
  711.          PosToReclaim = PosToUse
  712.       GOTO 12620
  713. 12622 END SUB
  714. 13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
  715. ' $PAGE
  716. '
  717. '  NAME    -- UpdtCalr
  718. '
  719. '  INPUTS  --     PARAMETER                    MEANING
  720. '                 ErrMsg$                   MESSAGE TO GO IN CALLER LOG
  721. '                 EXTLog               = 1  CHECK FOR EXTENDED LOGGING
  722. '                                           BEFORE UPDATING.
  723. '                                      = 2  UPDATE CALLER LOG WITH ZWasZ$
  724. '
  725. '  OUTPUTS -- ZCurDate$           CURRENT DATE (MM-DD-YY)
  726. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  727. '             TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  728. '
  729. '  PURPOSE -- To update the caller's file and/or print on the
  730. '             local printer if it is enabled
  731. '
  732.       SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
  733.       ON ERROR GOTO 65000
  734.       IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
  735.          EXIT SUB
  736.       WasX$ = "     " + ErrMsg$
  737. 13663 ZErrCode = 0
  738.       FIELD 4, 64 AS ZCallersRecord$
  739.       IF ZErrCode > 0 THEN _
  740.          CALL QuickTPut1 ("Caller's file:  error"+STR$(ZErrCode)) : _
  741.          ZErrCode = 0 : _
  742.          EXIT SUB
  743.       ON EXTLog GOTO 13665,13670
  744. '
  745. ' ****  EXTENDED LOGGING ENTRY  ***
  746. '
  747. 13665 IF NOT ZExtendedLogging THEN _
  748.          EXIT SUB
  749.       CALL AMorPM                                                    ' KG061203
  750.       WasX$ = WasX$ + " at " + ZTime$
  751. '
  752. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****
  753. '
  754. 13670 LSET ZCallersRecord$ = WasX$
  755.       CALL Printit (ZCallersRecord$)
  756.       IF ZLocalUser AND ZPrinter THEN _
  757.          EXIT SUB
  758.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  759. 13672 PUT 4,ZCallersFileIndex!
  760.       END SUB
  761. 13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
  762. ' $PAGE
  763. '
  764. '  NAME    -- Printit
  765. '
  766. '  INPUTS  --     PARAMETER                    MEANING
  767. '                 Strng$              STRING TO WRITE TO THE Printer
  768. '
  769. '  OUTPUTS -- NONE
  770. '
  771. '  PURPOSE -- To write to the printer attached to the pc running
  772. '             RBBS-PC and toggle the printer switch off whenever
  773. '             the printer is/becomes unavailable
  774. '
  775.       SUB Printit (Strng$) STATIC
  776.       ON ERROR GOTO 65000
  777. 13674 IF ZPrinter THEN _
  778.          LPRINT Strng$
  779.       END SUB
  780. 20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
  781. ' $PAGE
  782. '
  783. '  NAME    -- ChangeDir
  784. '
  785. '  INPUTS  -- PARAMETER                    MEANING
  786. '             NewDir$                      NAME OF SUBDIRECTORY
  787. '
  788. '  OUTPUTS -- ZOK                           TRUE IF CHDIR SUCCESSFUL
  789. '             ZErrCode                      ERROR CODE
  790. '
  791. '  PURPOSE -- Change subdirectory
  792. '
  793.       SUB ChangeDir (NewDir$) STATIC                                 ' KG123103
  794.       ON ERROR GOTO 65000
  795.       ZErrCode = 0
  796.       ZOK = ZTrue
  797. 20103 CHDIR NewDir$                                                  ' KG123103
  798.       END SUB
  799. 20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
  800. ' $PAGE
  801. '
  802. '  NAME    -- FINDITX
  803. '
  804. '  INPUTS  -- PARAMETER                    MEANING
  805. '             FilName$                 NAME OF FILE TO FIND
  806. '             FileNum                  # TO OPEN FILE AS             ' KG061001
  807. '
  808. '  OUTPUTS -- ZOK                      TRUE IF FILE EXISTS
  809. '             ZErrCode                 ERROR CODE
  810. '
  811. '  PURPOSE -- Determine whether a file exists
  812. '
  813.       SUB FindItX (FilName$,FileNum) STATIC                          ' KG061001
  814.       ON ERROR GOTO 65000
  815.       ZErrCode = 0
  816.       ZOK = ZFalse
  817.       IF LEN(FilName$) < 1 THEN _
  818.          EXIT SUB
  819.       IF ZTurboRBBS THEN _
  820.          CALL FindFile (FilName$,ZOK) : _
  821.          IF ZOK THEN _
  822.             GOTO 20222 _
  823.          ELSE EXIT SUB
  824. 20221 CALL BadFileChar (FilName$,ZOK)
  825.       IF NOT ZOK THEN _
  826.          EXIT SUB
  827.       ZOK = ZFalse
  828.       NAME FilName$ AS FilName$
  829.       IF ZErrCode = 53 THEN _
  830.          ZErrCode = 0 : _                                            ' AC082901
  831.          EXIT SUB
  832. 20222 CLOSE FileNum                                                  ' KG061001
  833. 20223 CALL OpenWork (FileNum,FilName$)                               ' KG061001
  834.       IF ZErrCode = 64 OR ZErrCode = 76 THEN _
  835.          ZOK = ZFalse : _                                            ' KG012603
  836.          EXIT SUB
  837.       ZOK = ZTrue
  838.       END SUB
  839. 20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from  comm. port'
  840. ' $PAGE
  841. '
  842. '  NAME -- FlushCom
  843. '
  844. '  INPUTS --   PARAMETER     MEANING
  845. '              STrng$       STRING TO READ CHARACTERS INTO FROM
  846. '                           THE COMMUNICATIONS PORT (FILE #3)
  847. '
  848. '  OUTPUTS --   Strng$
  849. '
  850. '  PURPOSE -- Reads all characters from the communications port.
  851. '
  852.       SUB FlushCom (Strng$) STATIC
  853.       ON ERROR GOTO 65000
  854.       IF ZLocalUser THEN _
  855.          EXIT SUB
  856.       Strng$ = ""
  857. 20310
  858. 20311 Strng$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  859. 20312 IF ZErrCode = 57 THEN _
  860.          LineStatus = INP(ZLineStatusReg) : _
  861.          ZErrCode = 0 : _
  862.          GOTO 20311
  863.       END SUB
  864. '
  865. '  'Pe 02/04/90  Moved FileLock sub here for Error Traping
  866. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  867. ' $PAGE
  868. '
  869. '  NAME    -- FileLock
  870. '
  871. '  INPUTS  --     PARAMETER                    MEANING
  872. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  873. '                                      2 FLUSH MESSAGE RECORD TO DISK
  874. '                                        AND UNLOCK MESSAGES
  875. '                                      3 LOCK MESSAGE FILE
  876. '                                      4 UNLOCK MESSAGE FILE
  877. '                                      5 LOCK USER FILE
  878. '                                      6 LOCK 4 RECORD BLOCK IN USER
  879. '                                        FILE
  880. '                                      7 UNLOCK USER FILE
  881. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  882. '                                        FILE
  883. '                                      9 LOCK UPLOAD DIRECTORY OR
  884. '                                        COMMENTS FILE
  885. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  886. '                                        COMMENTS FILE
  887. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  888. '               ZActiveUserFile$         NAME OF USER FILE
  889. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  890. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  891. '                                        FILE NAME TO LOCK/UNLOCK
  892. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  893. '
  894. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  895. '             ZBlk
  896. '             ZLockDrive
  897. '             ZLockFileName$
  898. '             ZLockStatus$
  899. '             ZMsgFileLock
  900. '             ZUserBlockLock
  901. '             ZUserFileLock
  902. '             ZUserFileIndex
  903. '
  904. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  905. '             multiple copies of RBBS-PC are sharing the same
  906. '             files in either a multi-tasking DOS environment or
  907. '             in a local area network environment
  908. '
  909.       SUB FileLock STATIC
  910.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  911.                                     26500,27000,27500,29000,29500
  912.       EXIT SUB
  913. '
  914. '
  915. ' *  UNLOCK USERS AND MESSAGES
  916. '
  917. '
  918. 21995 GOSUB 27000
  919.       GOSUB 25000
  920.       RETURN
  921. '
  922. '
  923. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  924. '
  925. '
  926. 21996 CLOSE 1
  927.       IF ZShareIt THEN _
  928.          OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
  929.       ELSE OPEN "I",1,ZConfigFileName$
  930. '
  931. '
  932. ' *  UNLOCK MESSAGES
  933. '
  934. '
  935.       GOSUB 25000
  936.       CALL OpenMsg
  937.       RETURN
  938. '
  939. '
  940. ' *  LOCK MESSAGE FILE
  941. '
  942. '
  943. 22000 IF ZMsgFileLock = ZTrue THEN _
  944.          RETURN
  945.       ZMsgFileLock = ZTrue
  946.       MID$(ZLockStatus$,1,2) = "LM"
  947.       ZSubParm = 2
  948.       CALL Line25
  949.       ZLockFileName$ = ZActiveMessageFile$
  950.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  951.       RETURN
  952. '
  953. '
  954. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  955. '
  956. '
  957. 22100 WasAX = &H0
  958.       WasBX = &H1
  959.       IF ZMultiLinkPresent > 0 THEN _
  960.          CALL RBBSML(WasAX,WasBX)
  961.       RETURN
  962. '
  963. '
  964. ' *  LOCK MESSAGE FILE (OMNINET)
  965. '
  966. '
  967. 22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  968.       WasCC$ = CHR$(1) + _
  969.             LEFT$(Prefix$ + SPACE$(8),8)
  970.       GOSUB 28000
  971.       IF WasCT = 0 THEN _
  972.          RETURN
  973.       CALL DelayTime (1)
  974.       GOTO 22200
  975. '
  976. '
  977. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  978. ' *  LOCK USER FILE (ORCHID PC-NET)
  979. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  980. '
  981. '
  982. 22300 GOSUB 28100
  983.       CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
  984.       RETURN
  985. '
  986. '
  987. ' *  LOCK SYSTEM (DESQview)
  988. '
  989. '
  990. 22400 CALL DVLock("MESSAGE")
  991.       RETURN
  992. '
  993. '
  994. ' *  LOCK MESSAGE FILE (10 NET)
  995. ' *  LOCK USER FILE (10 NET)
  996. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  997. '
  998. '
  999. 22500 GOSUB 28100
  1000.       CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
  1001.       RETURN
  1002. '
  1003. '
  1004. ' *  UNLOCK MESSAGE FILE
  1005. '
  1006. '
  1007. 25000 IF NOT ZMsgFileLock THEN _
  1008.          RETURN
  1009.       ZMsgFileLock = ZFalse
  1010.       MID$(ZLockStatus$,1,2) = "UM"
  1011.       ZSubParm = 2
  1012.       CALL Line25
  1013.       ZLockFileName$ = ZActiveMessageFile$
  1014.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  1015.       RETURN
  1016. '
  1017. '
  1018. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1019. '
  1020. '
  1021. 25100 WasAX = &H100
  1022.       WasBX = &H1
  1023.       IF ZMultiLinkPresent > 0 THEN _
  1024.          CALL RBBSML(WasAX,WasBX)
  1025.       RETURN
  1026. '
  1027. '
  1028. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1029. '
  1030. '
  1031. 25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1032.       WasCC$ = CHR$(17) + _
  1033.             LEFT$(Prefix$ + SPACE$(8),8)
  1034.       GOSUB 28000
  1035.       IF WasCT = 128 THEN _
  1036.          RETURN
  1037.       CALL DelayTime (1)
  1038.       GOTO 25200
  1039. '
  1040. '
  1041. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1042. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1043. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1044. '
  1045. '
  1046. 25300 GOSUB 28100
  1047.       CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1048.       RETURN
  1049. '
  1050. '
  1051. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1052. '
  1053. '
  1054. 25400 CALL DVUnlock("MESSAGE")
  1055.       RETURN
  1056. '
  1057. '
  1058. ' *  UNLOCK MESSAGE FILE (10 NET)
  1059. ' *  UNLOCK USER FILE (10 NET)
  1060. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1061. '
  1062. '
  1063. 25500 GOSUB 28100
  1064.       CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
  1065.       RETURN
  1066.  
  1067. '
  1068. '
  1069. ' *  LOCK USER FILE
  1070. '
  1071. '
  1072. 26000 IF ZUserFileLock = ZTrue THEN _
  1073.          RETURN
  1074.       ZUserFileLock = ZTrue
  1075.       MID$(ZLockStatus$,4,2) = "LU"
  1076.       ZSubParm = 2
  1077.       CALL Line25
  1078.       ZLockFileName$ = ZActiveUserFile$
  1079.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  1080.       RETURN
  1081. '
  1082. '
  1083. ' *  LOCK USER FILE (MULTI-LINK)
  1084. '
  1085. '
  1086. 26100 WasAX = &H0
  1087.       WasBX = &H2
  1088.       IF ZMultiLinkPresent > 0 THEN _
  1089.          CALL RBBSML(WasAX,WasBX)
  1090.       RETURN
  1091. '
  1092. '
  1093. ' *  LOCK USER FILE (OMNINET)
  1094. '
  1095. '
  1096. 26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1097.       WasCC$ = CHR$(1) + _
  1098.             LEFT$(Prefix$ + SPACE$(8),8)
  1099.       GOSUB 28000
  1100.       IF WasCT = 0 THEN _
  1101.          RETURN
  1102.       CALL DelayTime (1)
  1103.       GOTO 26200
  1104. '
  1105. '
  1106. ' *  LOCK USER FILE (DESQVIEW)
  1107. '
  1108. '
  1109. 26300 CALL DVLock("USER")
  1110.       RETURN
  1111. '
  1112. '
  1113. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1114. '
  1115. '
  1116. 26500 IF ZUserBlockLock = ZTrue THEN _
  1117.          RETURN
  1118.       ZUserBlockLock = ZTrue
  1119.       ZBlk = (ZUserFileIndex / 4) + .26
  1120.       MID$(ZLockStatus$,7,2) = "LB"
  1121.       ZSubParm = 2
  1122.       CALL Line25
  1123.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  1124.       RETURN
  1125. '
  1126. '
  1127. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1128. '
  1129. '
  1130. 26600 WasAX = &H0
  1131.       WasBX = ZBlk + 10
  1132.       IF ZMultiLinkPresent > 0 THEN _
  1133.          CALL RBBSML(WasAX,WasBX)
  1134.       RETURN
  1135. '
  1136. '
  1137. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1138. '
  1139. '
  1140. 26700 WasCC$ = CHR$(1) + _
  1141.             "BLK" + _
  1142.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1143.       GOSUB 28000
  1144.       IF WasCT = 0 THEN _
  1145.          RETURN
  1146.       CALL DelayTime (1)
  1147.       GOTO 26700
  1148. '
  1149. '
  1150. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1151. '
  1152. '
  1153. 26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1154.       RETURN
  1155. '
  1156. '
  1157. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1158. '
  1159. '
  1160. 26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1161.                         "BLK" + _
  1162.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1163.       GOTO 22300
  1164. '
  1165. '
  1166. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1167. '
  1168. '
  1169. 26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1170.                         "BLK" + _
  1171.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1172.       GOTO 22500
  1173. '
  1174. '
  1175. ' *  UNLOCK USER FILE
  1176. '
  1177. '
  1178. 27000 IF NOT ZUserFileLock THEN _
  1179.          RETURN
  1180.       ZUserFileLock = ZFalse
  1181.       MID$(ZLockStatus$,4,2) = "UU"
  1182.       ZSubParm = 2
  1183.       CALL Line25
  1184.       ZLockFileName$ = ZActiveUserFile$
  1185.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1186.       RETURN
  1187. '
  1188. '
  1189. ' *  UNLOCK USER FILE (MULTI-LINK)
  1190. '
  1191. '
  1192. 27100 WasAX = &H100
  1193.       WasBX = &H2
  1194.       IF ZMultiLinkPresent > 0 THEN _
  1195.          CALL RBBSML(WasAX,WasBX)
  1196.       RETURN
  1197. '
  1198. '
  1199. ' *  UNLOCK USER FILE (OMNINET)
  1200. '
  1201. '
  1202. 27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1203.       WasCC$ = CHR$(17) + _
  1204.             LEFT$(Prefix$ + SPACE$(8),8)
  1205.       GOSUB 28000
  1206.       IF WasCT = 128 THEN _
  1207.          RETURN
  1208.       CALL DelayTime (1)
  1209.       GOTO 27200
  1210. '
  1211. '
  1212. ' *  UNLOCK USER FILE (DESQVIEW)
  1213. '
  1214. '
  1215. 27300 CALL DVUnlock("USER")
  1216.       RETURN
  1217. '
  1218. '
  1219. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1220. '
  1221. '
  1222. 27500 IF NOT ZUserBlockLock THEN _
  1223.          RETURN
  1224.       ZUserBlockLock = ZFalse
  1225.       ZBlk = (ZUserFileIndex / 4) + .26
  1226.       MID$(ZLockStatus$,7,2) = "UB"
  1227.       ZSubParm = 2
  1228.       CALL Line25
  1229.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1230.       RETURN
  1231. '
  1232. '
  1233. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1234. '
  1235. '
  1236. 27600 WasAX = &H100
  1237.       WasBX = ZBlk + 10
  1238.       IF ZMultiLinkPresent > 0 THEN _
  1239.          CALL RBBSML(WasAX,WasBX)
  1240.       RETURN
  1241. '
  1242. '
  1243. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1244. '
  1245. '
  1246. 27700 WasCC$ = CHR$(17) + _
  1247.             "BLK" + _
  1248.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1249.       GOSUB 28000
  1250.       IF WasCT = 128 THEN _
  1251.          RETURN
  1252.       CALL DelayTime (1)
  1253.       GOTO 27700
  1254. '
  1255. '
  1256. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1257. '
  1258. '
  1259. 27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1260.       RETURN
  1261. '
  1262. '
  1263. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1264. '
  1265. '
  1266. 27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1267.                         "BLK" + _
  1268.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1269.       GOTO 25300
  1270. '
  1271. '
  1272. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1273. '
  1274. '
  1275. 27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1276.                         "BLK" + _
  1277.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1278.       GOTO 25500
  1279. '
  1280. '
  1281. ' *  CORVUS OMNINET INTERFACE
  1282. '
  1283. '
  1284. 28000 WasCC$ = ZLineFeed$ + _
  1285.             CHR$(0) + _
  1286.             CHR$(11) + _
  1287.             WasCC$
  1288.       CALL CDSend(WasCC$)
  1289.       CALL CDRecv(ZWasCN$)
  1290.       WasCT = ASC(MID$(ZWasCN$,3,1))
  1291.       IF WasCT => 128 THEN _
  1292.          CALL LPrnt("CORVUS LOCK FAIL",1) : _
  1293.          ZSubParm = -1
  1294. 28010 WasCT = ASC(MID$(ZWasCN$,4,1))
  1295.       IF WasCT => 129 THEN _
  1296.          CALL LPrnt("CORVUS FULL",1) : _
  1297.          ZSubParm = -1
  1298.       RETURN
  1299. '
  1300. '
  1301. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1302. '
  1303. '
  1304. 28100 CALL AllCaps (ZLockFileName$)
  1305.       ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
  1306.       ZLockFileName$ = ZLockFileName$ + _
  1307.                         STRING$(32 - LEN(ZLockFileName$),0)
  1308.       ZWasA = 0
  1309.       RETURN
  1310. '
  1311. '
  1312. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1313. '
  1314. '
  1315. 29000 IF LockedEn$ = ZWasEN$ THEN _
  1316.          RETURN
  1317.       LockedEn$ = ZWasEN$
  1318.       MID$(ZLockStatus$,10,2) = "LD"
  1319.       ZSubParm = 2
  1320.       CALL Line25
  1321.       ZLockFileName$ = ZWasEN$
  1322.       ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
  1323. 29010 RETURN
  1324. '
  1325. '
  1326. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1327. '
  1328. '
  1329. 29100 WasAX = &H0
  1330.       WasBX = &H3
  1331.       IF ZMultiLinkPresent > 0 THEN _
  1332.          CALL RBBSML(WasAX,WasBX)
  1333.       RETURN
  1334. '
  1335. '
  1336. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1337. '
  1338. '
  1339. 29300 CALL DVLock("MISC")
  1340.       RETURN
  1341. '
  1342. '
  1343. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1344. '
  1345. '
  1346. 29500 IF LockedEn$ <> ZWasEN$ THEN _
  1347.          RETURN
  1348.       LockedEn$ = ""
  1349.       MID$(ZLockStatus$,10,2) = "UD"
  1350.       ZSubParm = 2
  1351.       CALL Line25
  1352.       ZLockFileName$ = ZWasEN$
  1353.       ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
  1354. 29510 RETURN
  1355. '
  1356. '
  1357. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1358. '
  1359. '
  1360. 29600 WasAX = &H100
  1361.       WasBX = &H3
  1362.       IF ZMultiLinkPresent > 0 THEN _
  1363.          CALL RBBSML(WasAX,WasBX)
  1364.       EXIT SUB
  1365. '
  1366. '
  1367. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1368. '
  1369. '
  1370. 29650 CALL DVUnlock("MISC")
  1371.       RETURN
  1372. '
  1373. '
  1374. ' *  NetBIOS SEMAPHORE LOCK MECHANISM
  1375. ' *     Only the USERS file is actually locked.  All other files are locked
  1376. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1377. ' *     file semaphore as follows:
  1378. ' *        RECORD 1 = MESSAGES file lock status
  1379. ' *        RECORD 2 = Comments/Upload dir locked
  1380. ' *        RECORD 3 = entire USERS file lock
  1381. '
  1382. '
  1383. ' * Lock MESSAGES
  1384. 29700 CALL NetBIOS (1,6,1)
  1385.       RETURN
  1386.  
  1387. ' * Lock Comments/Upload dir
  1388. 29710 CALL NetBIOS (1,6,2)
  1389.       RETURN
  1390.  
  1391. ' * Lock USERS file
  1392. 29720 CALL NetBIOS (1,6,3)
  1393.       RETURN
  1394.  
  1395. ' * Lock single USERS record
  1396. 29730 CALL NetBIOS (1,6,3)
  1397.       RETURN
  1398.  
  1399. ' * UNLOCK MESSAGES
  1400. 29800 CALL NetBIOS (0,6,1)
  1401.       RETURN
  1402.  
  1403. ' * UNLOCK Comments/Upload dir
  1404. 29810 CALL NetBIOS (0,6,2)
  1405.       RETURN
  1406.  
  1407. ' * UNLOCK USERS file
  1408. 29820 CALL NetBIOS (0,6,3)
  1409.       RETURN
  1410.  
  1411. ' * UNLOCK single USERS record
  1412. 29830 CALL NetBIOS (0,6,3)
  1413.       RETURN
  1414.       END SUB
  1415. 29898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
  1416. ' $PAGE
  1417. '
  1418. '  NAME    -- NetBIOS   (WRITTEN BY DOUG AZZARITO)
  1419. '
  1420. '  INPUTS  -- IBMLockCmd       = 1-LOCK, 0-UNLOCK
  1421. '             IBMFileLock      = 5 USERS FILE
  1422. '                              = 6 SEMAPHORE FILE
  1423. '             IBMRecLock       = RECORD NUMBER TO LOCK
  1424. '
  1425. '  OUTPUTS -- NONE
  1426. '
  1427. '  PURPOSE -- Lock and unlock files using NetBIOS commands.
  1428. '             If lock fails, this routine tries forever.
  1429. '
  1430.       SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
  1431.       STATIC IBMCount
  1432.       ON ERROR GOTO 65000
  1433. 29900 ON IBMLockCmd + 1 GOTO 29920, 29910
  1434.       EXIT SUB
  1435. '
  1436. ' *****  LOCK LOOP   ****
  1437. '
  1438. 29910 ZErrCode = 0
  1439.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  1440.          IBMCount = IBMCount + 1 : _
  1441.          IF IBMCount > 1 THEN _
  1442.             EXIT SUB
  1443.       LOCK IBMFileLock, IBMRecLock TO IBMRecLock
  1444.       IF ZErrCode <> 0 THEN _
  1445.          GOTO 29910
  1446.       EXIT SUB
  1447. 29920 ZErrCode = 0
  1448.       IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
  1449.          IBMCount = IBMCount - 1 : _
  1450.          IF IBMCount > 0 THEN _
  1451.             EXIT SUB _
  1452.          ELSE IBMCount = 0
  1453.       UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
  1454.       IF ZErrCode <> 0 THEN _
  1455.          GOTO 29920
  1456.       END SUB
  1457. 43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
  1458. ' $PAGE
  1459. '
  1460. '  NAME    -- UpdateC
  1461. '
  1462. '  INPUTS  --     PARAMETER                    MEANING
  1463. '             ZCallersFileIndex!
  1464. '             ZFirstName$
  1465. '             ZWasHHH
  1466. '             ZLastName$
  1467. '             ZWasMMM
  1468. '             ZWasNG$
  1469. '             ZWasSSS
  1470. '             ZSysopFirstName$
  1471. '             ZSysopLastName$
  1472. '
  1473. '  OUTPUTS -- ZCallersRecord$
  1474. '             ZCallersFileIndex!
  1475. '             ZSysop
  1476. '
  1477. '  PURPOSE -- Update the callers file at logoff so that the number
  1478. '             of hours, minutes, and seconds for the session are
  1479. '             recorded as the last 9 characters of the 64-character
  1480. '             callers file record
  1481. '
  1482.       SUB UpdateC STATIC
  1483.       ON ERROR GOTO 65000
  1484.       IF ZExitToDoors THEN EXIT SUB                              'DGS-005
  1485.       IF ZCallersFilePrefix$ = "" THEN _
  1486.          EXIT SUB
  1487. '
  1488. ' ****  UPDATE CALLERS FILE AT LOGOFF  ***
  1489. '
  1490. 43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
  1491.       LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
  1492.       LSET Hours$ = STR$(ZSessionHour)
  1493.       LSET Minutes$ = STR$(ZSessionMin)
  1494.       LSET Seconds$ = STR$(ZSessionSec)
  1495.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  1496.       PUT 4,ZCallersFileIndex!
  1497.       FIELD 4,64 AS ZCallersRecord$
  1498.       LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
  1499.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  1500.       PUT 4,ZCallersFileIndex!
  1501. 43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
  1502.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  1503.       PUT 4,ZCallersFileIndex!
  1504.       ZCallersFileIndex! = ZCallersFileIndex! + 1
  1505.       PUT 4,ZCallersFileIndex!
  1506.       IF ZOrigCallers$ <> ZCallersFile$ THEN _
  1507.          ZCallersFile$ = ZOrigCallers$ : _
  1508.          CALL SetCall : _
  1509.          GOTO 43050
  1510.       END SUB
  1511. 51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
  1512. ' $PAGE
  1513. '
  1514. '  NAME    -- FindFree
  1515. '
  1516. '  INPUTS  --     PARAMETER                    MEANING
  1517. '                 ZWasZ$                       NAME OF FILE TO FIND
  1518. '
  1519. '  OUTPUTS -- ZFreeSpace$                      NUMBER OF BYTES FREE
  1520. '
  1521. '  PURPOSE -- To determine amount of free space on a device
  1522. '
  1523.       SUB FindFree STATIC
  1524.       ON ERROR GOTO 65000
  1525.       ZErrCode = 0
  1526. 52000 IF ZTurboRBBS THEN _
  1527.          GOTO 52003
  1528.       ZFreeSpace$ = ""
  1529.       CLS
  1530.       ZErrCode = 0
  1531. 52001 FILES ZWasZ$
  1532.       IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
  1533.          CALL OpenOutW (ZWasZ$) : _
  1534.          GOTO 52000
  1535.       IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
  1536.          ZOutTxt$ = "Upload directory missing.  Tell SYSOP" : _
  1537.          ZSubParm = 6 : _
  1538.          CALL TPut : _
  1539.          GOTO 52002
  1540.       FOR WasX = 1 TO 25
  1541.          ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
  1542.       NEXT
  1543. 52002 ZSubParm = 1
  1544.       CALL Line25
  1545.       EXIT SUB
  1546. 52003 WasAX = 0
  1547.       WasBX = 0
  1548.       WasCX = 0
  1549.       WasDX = 0
  1550.       IF MID$(ZWasZ$,2,1) = ":" THEN _
  1551.          WasAX = ASC(ZWasZ$) - ASC("A") + 1
  1552.       CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
  1553.       WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0)))        ' DA050204
  1554.       WasI# = WasI# * WasCX
  1555.       ZFreeSpace$ = STR$(WasI#) + _
  1556.                     " bytes free"
  1557.       END SUB
  1558. 57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
  1559. ' $PAGE
  1560. '
  1561. '  NAME   -- OpenWork
  1562. '
  1563. '  INPUTS --     PARAMETER                    MEANING
  1564. '                FileNum                    # OF FILE TO OPEN AS
  1565. '                FilName$                   NAME OF FILE TO FIND
  1566. '                ZShareIt                   USE DOS' "SHARE" FACILITIES
  1567. '
  1568. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1569. '
  1570. '  PURPOSE -- To open RBBS-PC's "work" file (number 2)
  1571. '
  1572.       SUB OpenWork (FileNum,FilName$) STATIC
  1573.       ON ERROR GOTO 65000
  1574. 58000 CLOSE FileNum
  1575. 58010 ZErrCode = 0
  1576. 58020 IF ZShareIt THEN _
  1577.          OPEN FilName$ FOR INPUT SHARED AS #FileNum _
  1578.       ELSE OPEN "I",FileNum,FilName$
  1579.       IF ZErrCode = 52 THEN _
  1580.          GOTO 58010
  1581. 58030 END SUB
  1582. 58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
  1583. ' $PAGE
  1584. '
  1585. '  NAME    -- OpenFMS
  1586. '
  1587. '  INPUTS  -- PARAMETER                      MEANING
  1588. '             ZShareIt                DOS SHARING FLAG
  1589. '             ZFMSDirectory$          NAME OF FMS DIRECTORY
  1590. '
  1591. '  OUTPUTS -- LastRec                NUMBER OF THE Last
  1592. '                                    RECORD IN THE FILE
  1593. '
  1594. '  PURPOSE -- To open the upload directory as a random file and find
  1595. '             the number of the last record in the file.
  1596. '
  1597.       SUB OpenFMS (LastRec) STATIC
  1598.       ON ERROR GOTO 65000
  1599. '      FileLength = 38 + ZMaxDescLen
  1600.       FileLength = 32 + ZMaxDescLen                    ' Bh 082790
  1601.       CLOSE 2
  1602.       IF ZActiveFMSDir$ = "" THEN _
  1603.          IF ZMenuIndex = 6 THEN _
  1604.             ZActiveFMSDir$ = ZLibDir$ _
  1605.          ELSE ZActiveFMSDir$ = ZFMSDirectory$
  1606.       IF ZShareIt THEN _
  1607.          OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=FileLength _
  1608.       ELSE OPEN "R",2,ZActiveFMSDir$,FileLength
  1609. '      IF ZErrCode > 0 THEN _
  1610. '         CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
  1611. '                     ZActiveFMSDir$) : _
  1612. '         END
  1613. If ZErrCode > 0 Then                    'Pe 02/02/90
  1614.    ZerrCode = 0
  1615. Call QuickTPut1 (CHR$(7) +  "Error Has Occured...try again !!! ")
  1616.    LastRec = 0
  1617.    EXIT SUB
  1618. END IF
  1619.       LastRec = LOF(2)/FileLength
  1620.       IF ZActiveFMSDir$ = PrevFMS$ THEN _
  1621.          EXIT SUB
  1622.       PrevFMS$ = ZActiveFMSDir$
  1623.       FIELD 2, FileLength AS FMSRec$
  1624.       GET #2,1
  1625.       ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
  1626.       ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
  1627.       ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
  1628.       ZWasDF = INSTR(FMSRec$,"CH(")
  1629.       ZChainedDir$ = ""
  1630.       IF ZWasDF > 0 AND (NOT ZWasA) THEN _
  1631.          WasX = INSTR(ZWasDF,FMSRec$,")") : _
  1632.          IF WasX > 0 THEN _
  1633.             ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
  1634.             CALL FindFile (ZChainedDir$,ZOK) : _
  1635.             IF NOT ZOK THEN _
  1636.                ZChainedDir$ = ""
  1637.       END SUB
  1638. 58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
  1639. ' $PAGE
  1640. '
  1641. '  NAME    -- OpenOutW
  1642. '
  1643. '  INPUTS  --     PARAMETER                 MEANING
  1644. '                 ZFileName$            NAME OF FILE TO FIND
  1645. '                 ZShareIt              USE DOS' "SHARE" FACILITIES
  1646. '
  1647. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1648. '
  1649. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
  1650. '
  1651.       SUB OpenOutW (FilName$) STATIC
  1652.       ON ERROR GOTO 65000
  1653.       CLOSE 2
  1654. 58225 ZErrCode = 0
  1655. 58230 IF ZShareIt THEN _
  1656.          OPEN FilName$ FOR OUTPUT SHARED AS #2 _
  1657.       ELSE OPEN "O",2,FilName$
  1658. 58235 END SUB
  1659. 58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
  1660. ' $PAGE
  1661. '
  1662. '  NAME    -- KillWork
  1663. '
  1664. '  INPUTS  --     PARAMETER                    MEANING
  1665. '                 FilName$                  NAME OF FILE TO DELETE
  1666. '
  1667. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1668. '
  1669. '  SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
  1670. '
  1671.       SUB KillWork (FilName$) STATIC
  1672.       ON ERROR GOTO 65000
  1673.       CLOSE 2
  1674.       ZErrCode = 0
  1675. 58270 KILL FilName$
  1676. 58275 END SUB
  1677. 58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
  1678. ' $PAGE
  1679. '
  1680. '  NAME    -- GetPassword
  1681. '
  1682. '                          PARAMETER             MEANING
  1683. '  INPUTS  -- FILE # 2 OPENED
  1684. '
  1685. '  OUTPUTS -- ZTempPassword$
  1686. '             ZTempSecLevel
  1687. '             ZTempTimeAllowed
  1688. '             ZTempRegPeriod
  1689. '             ZTempMaxPerDay
  1690. '
  1691. '  PURPOSE -- To read the RBBS-PC "PASSWORDS" file
  1692. '
  1693.       SUB GetPassword STATIC
  1694.       ON ERROR GOTO 65000
  1695.       ZErrCode = 0
  1696.       INPUT #2,ZTempPassword$,     ZTempSecLevel, _
  1697.                ZTempTimeAllowed,  ZTempMaxPerDay, _
  1698.                ZTempRegPeriod,    ZStartTime, _
  1699.                ZEndTime,           ZByteMethod, _
  1700.                ZRatioRestrict#, ZInitialCredit#, _
  1701.                ZTempTimeLock
  1702. 58285 END SUB
  1703. 58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
  1704. ' $PAGE
  1705. '
  1706. '  NAME    -- ReadDir
  1707. '
  1708. '             PARAMETER                MEANING
  1709. '  INPUTS  -- FileNum                  WHICH # FILE TO READ
  1710. '             WhichLine                HOW MANY LINES TO ADVANCE
  1711. '
  1712. '  OUTPUTS -- ZOutTxt$
  1713. '
  1714. '  PURPOSE -- To read possible "DIR" files
  1715. '
  1716.       SUB ReadDir (FileNum,WhichLine) STATIC
  1717.       ON ERROR GOTO 65000
  1718.       ZErrCode = 0
  1719.       FOR WasI = 1 TO WhichLine
  1720.          LINE INPUT #FileNum,ZOutTxt$
  1721.       NEXT
  1722. 58295 END SUB
  1723. 58300 ' $SUBTITLE: 'ReadParms - subroutine to read parameter values'
  1724. ' $PAGE
  1725. '
  1726. '  NAME    -- ReadParms
  1727. '
  1728. '               PARAMETER             MEANING
  1729. '  INPUTS  -- FILE # 2 OPENED
  1730. '             NumParms               # parameters to read
  1731. '             WhichLine              Which set of parms to return
  1732. '  OUTPUTS -- ARA.TO.USER$           Array of string values
  1733. '             FILE.SECURITY
  1734. '             FilePswd$
  1735. '
  1736. '  PURPOSE -- To read different values, where values are
  1737. '             separated by a comma or carriage-return-line-feed.
  1738. '
  1739.       SUB ReadParms (AraToUse$(1),NumParms,WhichLine) STATIC
  1740.       ON ERROR GOTO 65000
  1741.       ZErrCode = 0
  1742.       FOR WasJ = 1 TO WhichLine
  1743.          FOR WasI = 1 TO NumParms
  1744.             INPUT #2,AraToUse$(WasI)
  1745.          NEXT
  1746.       NEXT
  1747. 58305 END SUB
  1748. 58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
  1749. ' $PAGE
  1750. '
  1751. '  NAME    -- ReadAny
  1752. '
  1753. '               PARAMETER             MEANING
  1754. '  INPUTS  -- FILE # 2 OPENED
  1755. '
  1756. '  OUTPUTS -- ZOutTxt$
  1757. '
  1758. '  PURPOSE -- To read file #2 into ZOutTxt$
  1759. '
  1760.       SUB ReadAny STATIC
  1761.       ON ERROR GOTO 65000
  1762.       ZErrCode = 0
  1763.       INPUT #2,ZOutTxt$
  1764. 58315 END SUB
  1765. 58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
  1766. ' $PAGE
  1767. '
  1768. '  NAME    -- PrintWork
  1769. '
  1770. '               PARAMETER             MEANING
  1771. '  INPUTS  -- FILE # 2 OPENED
  1772. '             STRING TO WRITE OUT
  1773. '
  1774. '  OUTPUTS -- NONE
  1775. '
  1776. '  PURPOSE -- To print a string to file #2
  1777. '
  1778.       SUB PrintWork (Strng$) STATIC
  1779.       ON ERROR GOTO 65000
  1780.       ZErrCode = 0
  1781.       PRINT #2,Strng$;
  1782. 58325 END SUB
  1783. 58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
  1784. ' $PAGE
  1785. '
  1786. '  NAME    -- GetWork
  1787. '
  1788. '               PARAMETER             MEANING
  1789. '  INPUTS  -- RecLen            Length of record
  1790. '
  1791. '  OUTPUTS -- NONE
  1792. '
  1793. '  PURPOSE -- To read a record from file #2
  1794. '
  1795.       SUB GetWork (RecLen) STATIC
  1796.       ON ERROR GOTO 65000
  1797.       ZErrCode = 0
  1798.       FIELD 2, RecLen AS ZDnldRecord$
  1799.       GET 2,(LOC(2)+1)
  1800. 58335 END SUB
  1801. 58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
  1802. ' $PAGE
  1803. '
  1804. '  NAME    -- OpenWorkA
  1805. '
  1806. '  INPUTS  --     PARAMETER                    MEANING
  1807. '              FilName$                  NAME OF FILE TO FIND
  1808. '              ZShareIt                  USE DOS' "SHARE" FACILITIES
  1809. '
  1810. '  OUTPUTS -- ZErrCode                        ERROR CODE
  1811. '
  1812. '  PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
  1813. '
  1814.       SUB OpenWorkA (FilName$) STATIC
  1815.       ON ERROR GOTO 65000
  1816.       CLOSE 2
  1817.       ZErrCode = 0
  1818.       IF ZShareIt THEN _
  1819.          OPEN FilName$ FOR APPEND SHARED AS #2 _
  1820.       ELSE OPEN "A",2,FilName$
  1821. 58345 END SUB
  1822. 58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
  1823. ' $PAGE
  1824. '
  1825. '  NAME    -- PrintWorkA
  1826. '
  1827. '                          PARAMETER             MEANING
  1828. '  INPUTS  --            FILE # 2 OPENED
  1829. '                        STRING TO WRITE OUT
  1830. '
  1831. '  OUTPUTS -- NONE
  1832. '
  1833. '  PURPOSE -- To print a string to file #2 followed by a carriage return
  1834. '
  1835.       SUB PrintWorkA (Strng$) STATIC
  1836.       ON ERROR GOTO 65000
  1837.       ZErrCode = 0
  1838.       PRINT #2,Strng$
  1839. 58355 END SUB
  1840. 58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
  1841. ' $PAGE
  1842. '
  1843. '  NAME    -- CheckInt
  1844. '
  1845. '             PARAMETER             MEANING
  1846. '  INPUTS  -- Strng$         STRING TO VERIFY CAN BE AN INTEGER
  1847. '
  1848. '  OUTPUTS -- ZErrCode             = 0 MEANS IT IS AN INTEGER VALUE
  1849. '                                 <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1850. '             ZTestedIntValue  Integer value of expression           ' KG083102
  1851. '
  1852. '  PURPOSE -- To validate that a string represents an integer
  1853. '
  1854.       SUB CheckInt (Strng$) STATIC
  1855.       ON ERROR GOTO 65000
  1856.       ZErrCode = 0
  1857.       WasX$ = Strng$                                                 ' KG083102
  1858.       CALL Trim (WasX$)                                              ' KG083102
  1859.       ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1))     ' KG083102
  1860. 58365 END SUB
  1861. 59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
  1862. ' $PAGE
  1863. '
  1864. '  NAME    --  PutCom
  1865. '
  1866. '  INPUTS  --   PARAMETER     MEANING
  1867. '                Strng$       STRING TO PRINT TO COMM PORT
  1868. '              ZFlowControl  WHETHER USING CLEAR TO SEND FOR FLOW
  1869. '                            CONTROL BETWEEN THE PC AND THE MODEM
  1870. '
  1871. '  OUTPUTS --
  1872. '
  1873. '  PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
  1874. '             before writing to the communications port.
  1875. '
  1876.       SUB PutCom (Strng$) STATIC
  1877.       ON ERROR GOTO 65000
  1878.       IF ZLocalUser THEN _
  1879.          EXIT SUB
  1880.       CALL CheckCarrier                                              ' KG061203
  1881.       IF ZSubParm = -1 THEN _
  1882.          EXIT SUB
  1883.       IF NOT ZXOffEd THEN _
  1884.          GOTO 59652
  1885.       ZSubParm = 1
  1886.       CALL Line25
  1887.       ZWasY$ = ZXOff$
  1888.       XOffTimeout! = TIMER + ZWaitBeforeDisconnect                   ' DA110304
  1889.       WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
  1890.          Char = -1
  1891.          WHILE Char = -1 AND ZSubParm <> -1
  1892.             GOSUB 59654
  1893.          WEND
  1894.          IF Char <> -1 THEN _
  1895.             CALL GetCom(ZWasY$) : _
  1896.             IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
  1897.                ZWasY$ = ZXOff$
  1898.       WEND
  1899.       ZXOffEd = ZFalse
  1900.       ZSubParm = 1
  1901.       CALL Line25
  1902. 59652 ZNotCTS = ZFalse
  1903.       PRINT #3,Strng$;
  1904.       EXIT SUB
  1905. 59653
  1906. 59654 CALL EofComm (Char)
  1907.       CALL GoIdle
  1908.       CALL CheckCarrier                                              ' KG061203
  1909.       CALL CheckTime(XOffTimeout!, TempElapsed!,1)                   ' DA110302
  1910.       IF ZSubParm = 2 THEN _                                         ' DA110302
  1911.          ZSubParm = -1                                               ' DA110302
  1912.       RETURN
  1913.       END SUB
  1914. 59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
  1915. ' $PAGE
  1916. '
  1917. '  NAME    -- PutWork
  1918. '
  1919. '  INPUTS  --   PARAMETER     MEANING
  1920. '                STNG$       STRING TO WRITE TO FILE
  1921. '                RecNum      RECORD NUMBER TO WRITE
  1922. '                RecLen      LENGTH OF RECORD TO WRITE
  1923. '
  1924. '  OUTPUTS --
  1925. '
  1926. '  PURPOSE -- Writes uploaded file records to work file
  1927. '
  1928.       SUB PutWork (Strng$,RecNum,RecLen) STATIC
  1929.       ON ERROR GOTO 65000
  1930.       FIELD #2,RecLen AS ZUpldRec$
  1931.       LSET ZUpldRec$ = Strng$
  1932.       RecNum = RecNum + 1
  1933.       PUT #2,RecNum
  1934.       END SUB
  1935. '
  1936. '********************************************************************
  1937. '  THREAD1            First message thread routine                  *
  1938. '  THREAD2            Second message thread routine                 *
  1939. '  THREAD3            Third message thread routine                  *
  1940. '********************************************************************
  1941. '===========================================================================
  1942. 59670 ' $SUBTITLE: 'Thread1 - create/update threaded message file'
  1943. ' $PAGE
  1944. '
  1945. '  SUBROUTINE NAME    -- THREAD1
  1946. '
  1947. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1948. '                           HighMsgNumber    This reply's message number
  1949. '                           CurMsg        Message number being replied
  1950. '
  1951. '  OUTPut PARAMETERS  --     <<NONE>>
  1952. '
  1953. '  SUBROUTINE PURPOSE -- SUBROUTINE TO...
  1954. '
  1955.       SUB Thread1 (HighMsgNumber,CurMsg,ZConfName$) STATIC
  1956. CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
  1957.         IF INSTR(ZConfName$," ") = 0 THEN   'PE102587
  1958.          ZFileName$ = Drive$ +ZConfName$ + "T"  'PE08/02/89
  1959.         ELSE
  1960.            ZFileName$ = Drive$ +LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'PE 08/02/89
  1961.       END IF
  1962.       CurMsg$ = STR$(CurMsg)
  1963.       HighMsgNumber$ = STR$(HighMsgNumber)
  1964.       OPEN "R",9,ZFileName$,12
  1965.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1966.       LSET CM$ = CurMsg$
  1967.       LSET HMN$ = HighMsgNumber$
  1968.       PUT #9,INT(LOF(9)/12)+1
  1969.       CLOSE (9)
  1970.  END SUB       ' THREAD1
  1971. '
  1972. 59671 ' $SUBTITLE: 'Thread2 - a message was killed - check threaded message file'
  1973. ' $PAGE
  1974. '
  1975. '  SUBROUTINE NAME    -- THREAD2
  1976. '
  1977. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  1978. '                           MsgToKill        Killed message's number
  1979. '
  1980. '  OUTPut PARAMETERS  --     <<NONE>>
  1981. '
  1982. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  1983. '
  1984.       SUB Thread2 (MsgToKill,ActiveMessages,ZConfName$) STATIC
  1985. CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
  1986.       IF INSTR(ZConfName$," ") = 0 THEN     'PE102587
  1987.         ZFileName$ = Drive$ +ZConfName$ + "T"   'Pe 08/02/89
  1988.       ELSE
  1989.         ZFileName$ = Drive$+LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
  1990.       END IF
  1991.       OPEN "R",9,ZFileName$,12
  1992.       FIELD 9, 6 AS CM$, 6 AS HMN$
  1993.        FOR I = 1 TO INT(LOF(9)/12)
  1994.           GET 9,I
  1995.           IF VAL(CM$) = MsgToKill THEN     ' MARK THE RECORD
  1996.              LSET CM$ = LEFT$(CM$,5) + "K"
  1997.              PUT 9,I
  1998.           ELSE 
  1999.            IF VAL(HMN$) = MsgToKill THEN     ' MARK THE RECORD
  2000.               LSET HMN$ = LEFT$(HMN$,5) + "K"
  2001.               LSET CM$ = LEFT$(CM$,5) + "K"
  2002.              PUT 9,I
  2003.           END IF
  2004.        END IF
  2005.       NEXT I
  2006.       CLOSE (9)
  2007.  END SUB      ' THREAD2
  2008. '
  2009. 59672 ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
  2010. ' $PAGE
  2011. '
  2012. '  SUBROUTINE NAME    -- THREAD3
  2013. '
  2014. '  INPUT PARAMETERS   --    PARAMETER              MEANING
  2015. '                           CurMsg        Message's number
  2016. '
  2017. '  OUTPut PARAMETERS  --     <<NONE>>
  2018. '
  2019. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ...
  2020. '
  2021.       SUB THREAD3 (CurMsg,ZConfName$) STATIC
  2022. IF ZJustSearching THEN _            'PE 02/05/90
  2023.  EXIT SUB                           'PE 01/16/89
  2024. CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
  2025.       IF INSTR(ZConfName$," ") = 0 THEN
  2026.          ZFileName$ = Drive$ +ZConfName$ + "T"   'pe 08/02/89
  2027.        ELSE
  2028.          ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
  2029.       END IF
  2030.        OPEN "R",9,ZFileName$,12 
  2031.        FIELD 9, 6 AS CM$, 6 AS HMN$
  2032.       AA$ = ""
  2033.       ZZ$ = ""
  2034.       FOR I = 1 TO INT(LOF(9)/12)
  2035.           GET 9,I
  2036.          IF RIGHT$(HMN$,1) = "K" THEN 59673
  2037.          IF VAL(CM$) = CurMsg AND RIGHT$(HMN$,1) <> "K" THEN 
  2038.                 AA$ = AA$ + HMN$
  2039.          END IF 
  2040.           IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) = "K" THEN
  2041.                 ZZ$ = LEFT$(CM$,5) + ZFG1$+"(deleted) "+ZEmphasizeOff$
  2042.          END IF
  2043.           IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) <> "K" THEN 
  2044.                 ZZ$ = CM$
  2045.          END IF
  2046. 59673 NEXT I
  2047.       IF LEN(AA$) > 0 THEN 
  2048. CALL QuickTPut(ZFG3$+"   Reply(ies) in message number(s): "+ZFG1$ + AA$+ZEmphasizeOff$,1)
  2049.       END IF
  2050.       IF LEN(ZZ$) > 0 THEN 
  2051. CALL QuickTPut (ZFG4$+"   This message is in reply to message " +ZFG1$+ ZZ$+ZEmphasizeOff$,1)
  2052.       END IF
  2053. CALL QuickTPut (ZFG2$+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+ZEmphasizeOff$,1)
  2054.       CLOSE (9)
  2055.  END SUB      ' THREAD3
  2056. '
  2057. 59674 ' $SUBTITLE: 'Thread4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
  2058. ' $PAGE
  2059. '
  2060. '  SUBROUTINE NAME    -- THREAD4
  2061. '
  2062. '  INPUT PARAMETERS   --    PARAMETER            MEANING
  2063. '
  2064. '                           MsgToRecover   MESSAGE NumBER BEING RECOVERED
  2065. '                           FirstMsgRecord NOT USED HERE BUT PASSED IN
  2066. '                                                FROM RBBS CALL TO SUB2
  2067. '                           ActionFlag          PASSED FROM SUB2 NEEDED TO
  2068. '                                                GIVE BACK TO RBBS MAIN CODE
  2069. '                           ZConfName$                 CONFERENCE NAME
  2070. '
  2071. '  OUTPut PARAMETERS  --      <<NONE>>
  2072. '
  2073. '  SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
  2074. '
  2075.       SUB Thread4 (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) STATIC
  2076. CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,EXT$,ZTrue) 'Pe 08/02/89
  2077.       IF INSTR(ZConfName$," ") = 0 THEN
  2078.          ZFileName$ = Drive$ + ZConfName$ + "T"   'Pe 08/02/89
  2079.       ELSE
  2080.          ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T"  'Pe 08/02/89
  2081.       END IF
  2082.       OPEN "R",9,ZFileName$,12               'WILL CREATE FILE IF NOT EXIST
  2083.       FIELD 9, 6 AS CM$, 6 AS HMN$
  2084.       FOR I = 1 TO INT(LOF(9)/12)
  2085.           GET 9,I
  2086.           IF VAL(CM$) = MsgToRecover THEN
  2087.              LSET CM$ = LEFT$(CM$,5) + " "
  2088.              PUT 9,I
  2089.           ELSE
  2090.               IF VAL(HMN$) = MsgToRecover THEN
  2091.                  LSET HMN$ = LEFT$(HMN$,5) + " "
  2092.                  LSET CM$ = LEFT$(CM$,5) + " "
  2093.                  PUT 9,I
  2094.               END IF
  2095.           END IF
  2096.       NEXT I
  2097.       CLOSE (9)
  2098. END SUB    'THREAD4
  2099. 59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
  2100. ' $PAGE
  2101. '
  2102. '  NAME    -- CommPut
  2103. '
  2104. '  INPUTS  --   PARAMETER     MEANING
  2105. '               Strng$        String to write
  2106. '               ZFossil       Whether using Fossil driver
  2107. '
  2108. '  OUTPUTS --
  2109. '
  2110. '  PURPOSE -- Send string to comm port.  Recovers from errors.
  2111. '
  2112.       SUB CommPut (Strng$) STATIC
  2113.       ON ERROR GOTO 65000
  2114.       PRINT #3,Strng$;
  2115.       END SUB
  2116. '59750' $SUBTITLE: 'DGSAlias - Subroutine to Create/Update Alias Info file'
  2117. ' $PAGE
  2118. '
  2119. '  SUBROUTINE NAME    -- DGSAlias
  2120. '
  2121. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2122. '                         ZConfName$                  CONFERENCE NAME
  2123. '                         ZOrigUserNameDGS$           USERS - LOG ON NAME
  2124. '                         DGSAlias$                   USERS - ALIAS NAME
  2125. '                         DGSStl$                     NULL FIRST TIME IN
  2126. '                                                     'STILL' IF ALIAS EXISTS
  2127. '                                                        OR REAL NAME
  2128. '                         DGSFileName$                CONFERENCE ALIAS FILE
  2129. '
  2130. '  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
  2131. '                         DGSFileName$
  2132. '
  2133. '  SUBROUTINE PURPOSE --  TO Read ConfA.DEF and Get Users ALIAS or
  2134. '                         Create One
  2135. '
  2136. '     SUB DGSAlias (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
  2137. '
  2138. '     IF DGSStl$ = "" THEN
  2139. '        ConfADefFlag = 0
  2140. '        CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)
  2141. '        DGSFileName$ = Drive$ + ZConfName$ + "A.DEF"
  2142. '        CALL FindIt (DGSFileName$)
  2143. '        IF ZOK THEN
  2144. '           ConfADefFlag = ZTrue
  2145. '        END IF
  2146. '        IF ConfADefFlag = ZTrue THEN
  2147. '           OPEN "I", 7, DGSFileName$
  2148. '           DGSAlias$ = ""
  2149. '           WHILE DGSAlias$ = "" AND NOT EOF(7)
  2150. '              INPUT #7, DGSUserName$, DGSTempAlias$
  2151. '              DGSUnl = LEN(DGSUserName$)
  2152. '              IF DGSUserName$ = LEFT$(ZOrigUserNameDGS$,DGSUnl) THEN
  2153. '                 DGSAlias$ = DGSTempAlias$
  2154. '              END IF
  2155. '           WEND
  2156. '           CLOSE 7
  2157. '        ELSE
  2158. '           DGSAlias$ = "NO CONFA.DEF"
  2159. '           EXIT SUB
  2160. '        END IF
  2161. '     END IF
  2162. '     CALL GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$)
  2163. '     END SUB
  2164. '
  2165. '
  2166. ' $SUBTITLE: 'GoodAls - Subroutine to Make Sure Alias Good'
  2167. ' $PAGE
  2168. '
  2169. '  SUBROUTINE NAME    -- GoodAls
  2170. '
  2171. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2172. '                         ZConfName$                  CONFERENCE NAME
  2173. '                         ZOrigUserNameDGS$           USERS - LOG ON NAME
  2174. '                         DGSAlias$                   USERS - ALIAS NAME
  2175. '                         DGSStl$                     NULL FIRST TIME IN
  2176. '                                                      'STILL' IF ALIAS EXISTS
  2177. '                                                         OR REAL NAME
  2178. '                         DGSFileName$                CONFERENCE ALIAS FILE
  2179. '
  2180. '  OUTPUT PARAMETERS  --  ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
  2181. '                         DGSFileName$
  2182. '
  2183. '  SUBROUTINE PURPOSE --  To Read ConfA.DEF and see if Users ALIAS is
  2184. '                         Aready in Use or a Real Name
  2185. '
  2186. '     SUB GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
  2187. '
  2188. '     IF DGSAlias$ = "" THEN
  2189. '        DGSSfnSln$ = ZSysopFirstName$+" "+ZSysopLastName$
  2190. '        ZOutTxt$ = "Do you" +DGSStl$+ " want to use an Alias? (Y,[N])"
  2191. '        ZSubParm = 1
  2192. '        CALL TGet
  2193. '        IF ZYes THEN
  2194. '           ABFlg$ = ""
  2195. '           ZOutTxt$ = "Enter Alias (31 Char. Max.) "
  2196. '           ZSubParm = 1
  2197. '           CALL TGet
  2198. '           CALL AllCaps (ZUserIn$)
  2199. '           IF ZUserIn$ = "" OR INSTR(SPACE$(31),ZUserIn$) > 0 THEN
  2200. '              ZUserIn$ = ""
  2201. '              ABFlg$ = "Alias Must NOT be Blank"
  2202. '           END IF
  2203. '           IF LEN(ZUserIn$) > 31 THEN
  2204. '              ZUserIn$= ""
  2205. '              ABFlg$ = "Length Must NOT Exceed 31 Characters"
  2206. '           END IF
  2207. '           IF ZUserIn$ = "SYSOP" OR ZUserIn$ = DGSSfnSln$ THEN
  2208. '              ZOutTxt$ = CHR$(7)+CHR$(7)
  2209. '              ZOutTxt$ = ZOutTxt$ + "Wrong Answer! Alias Request Denied!"
  2210. '              ZOutTxt$ = ZOutTxt$ + CHR$(13) + "Contact Sysop for Alias Retry"
  2211. '              CALL QuickTPut (ZOutTxt$,2)
  2212. '              DGSAlias$ = ZOrigUserNameDGS$+CHR$(250)
  2213. '              ZActiveUserName$ = ZOrigUserNameDGS$+CHR$(250)
  2214. '              ZFirstName$ = ZOrigUserNameDGS$+CHR$(250)
  2215. '           ELSE
  2216. '              OPEN "I", 7, DGSFileName$
  2217. '              WHILE ABFlg$ = "" AND NOT EOF(7)
  2218. '              INPUT #7, DGSUserName$, DGSTempAlias$
  2219. '              IF ZUserIn$ = DGSUserName$ THEN
  2220. '                 ABFlg$ = " is a Real User"
  2221. '              ELSE
  2222. '                 IF ZUserIn$ = DGSTempAlias$ THEN
  2223. '                    ABFlg$ = " has Already been Used"
  2224. '                 END IF
  2225. '              END IF
  2226. '              WEND
  2227. '              CLOSE 7
  2228. '              IF ABFlg$="" THEN
  2229. '                 DGSAlias$ = ZUserIn$
  2230. '                 ZActiveUserName$ = ZUserIn$
  2231. '                 ZFirstName$ = ZUserIn$
  2232. '              ELSE
  2233. '                 ZOutTxt$="Sorry "+ZFirstName$+" but "+ZUserIn$+ABFlg$
  2234. '                 CALL QuickTPut (ZOutTxt$,1)
  2235. '                 DGSStl$ = " still"
  2236. '                 DGSAlias$ = ""
  2237. '              END IF
  2238. '          END IF
  2239. '        ELSE
  2240. '           DGSAlias$ = ZOrigUserNameDGS$
  2241. '        END IF
  2242. '        IF DGSAlias$ <> "" THEN
  2243. '           CLOSE 2
  2244. '           FOR I = 1 TO LEN(DGSAlias$)
  2245. '              IF MID$(DGSAlias$,I,1)=CHR$(34) THEN MID$(DGSAlias$,I,1)=CHR$(39)
  2246. '           NEXT I
  2247. '           OPEN "A", 2, DGSFileName$
  2248. '           WRITE #2, ZOrigUserNameDGS$, DGSAlias$
  2249. '           CLOSE 2
  2250. '        END IF
  2251. '      ELSE
  2252. '        ZActiveUserName$ = DGSAlias$
  2253. '        ZFirstName$ = DGSAlias$
  2254. '      END IF
  2255. '      END SUB
  2256. 59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file'           ' AC012601
  2257. ' $PAGE
  2258. '
  2259. '  NAME    --  FindFile
  2260. '
  2261. '  INPUTS  --  PARAMETER         MENANING
  2262. '               FilName$         NAME OF FILE TO LOOK FOR
  2263. '               FExists          WHETHER FILE EXISTS
  2264. '
  2265. '  OUTPUTS --  RETURNED.VALUE    VALUE RETURNED
  2266. '                                TRUE  = FILE EXISTS
  2267. '                                TRUE = FILE DOES NOT EXIST
  2268. '
  2269. '  PURPOSE --  Determine whether passed file FilName$ exists
  2270. '              Unlike, FindIt, this routine does not open any
  2271. '              file and, hence, does not create one in determining
  2272. '              whether a file exists.
  2273. '
  2274.       SUB FindFile (FilName$,FExists) STATIC                         ' AC012601
  2275.       CALL BadFileChar (FilName$,FExists)                            ' AC012601
  2276. 59791 IF FExists THEN _                                              ' KG012802
  2277.          IOErrorCount = 0 : _                                        ' AC012601
  2278.          CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _            ' KG012601
  2279.          FExists = (WasZ = 0)                                        ' AC012601
  2280.       END SUB                                                        ' AC012601
  2281. '
  2282. ' ** OPEN RBBSCHAT.DEF AS #7
  2283. '
  2284. '59800 SUB OpenWrk7(ChatFileName$) STATIC
  2285. '      ON ERROR GOTO 65000
  2286. '      IF ZShareIt THEN
  2287. '         OPEN ChatFileName$ FOR RANDOM ACCESS READ WRITE SHARED AS #7 LEN = 128
  2288. '       ELSE
  2289. '         OPEN ChatFileName$ FOR RANDOM AS #7 LEN = 128
  2290. '      END IF
  2291. '      END SUB
  2292. '
  2293. ' ** DO ALL THE RBBSCHAT.DEF GET's AND PUT's HERE **
  2294. '
  2295. '59810 SUB LockIt7(Record, ReadIt) STATIC
  2296. '      ON ERROR GOTO 65000
  2297. '      IF ReadIt THEN
  2298. '         GET 7, Record
  2299. '       ELSE
  2300. '           IF ZShareIt THEN
  2301. '            LOCK 7, Record
  2302. '           END IF
  2303. '        PUT 7, Record
  2304. '           IF ZShareIt THEN
  2305. '              UNLOCK 7, Record
  2306. '           END IF
  2307. '      END IF
  2308. '      END SUB
  2309.  
  2310. '
  2311. ' $SUBTITLE: 'ViewTxt - Subroutine to display ASCII file from ARC file'
  2312. ' $PAGE
  2313. '
  2314.   SUB Viewtxt STATIC
  2315.   ON ERROR GOTO 65000
  2316. '
  2317. 60140 ZSubParm = 1 
  2318. ZOutTxt$ ="T)ype to Screen, X)tract, C)ompress, D)ir, H)elp or [RETURN] to Quit"  ' Bh
  2319.            ZTurboKey = -ZTurboKeyUser
  2320.            CALL TGet      'Pe 02/12/90
  2321.      IF ZSubParm = -1 or ZWasQ = 0 THEN _  'Pe 02/04/90
  2322.                          EXIT SUB          'Pe 05/24/89                    
  2323.         CALL AllCaps (ZUserIn$)
  2324.        MplX = INSTR("TXCD?HQ",ZUserIn$)
  2325.      ON MplX GOTO 60149,60168,60175,60142,60141,60141,60180
  2326. GOTO 60180
  2327. '
  2328. 60141 CALL BufFile (ZHelpPath$ + "ZIP" + ZHelpExtension$,WasX)  'Pe 03/26/89
  2329.       GOTO 60140                                             'Pe 03/26/89
  2330. 60142  CALL QuickTPut ("Creating file list, one moment please....",1)
  2331.    EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST"  'Pe 01/24/90
  2332.    SHELL EXTRACT$
  2333. CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX)
  2334. GOTO 60140
  2335. '
  2336. 60149 ZSubParm = 1
  2337.      ZOutTxt$ = "Which file(s) should I display, R)elist or [RETURN] to quit"         'DMOD1  ' Bh
  2338.      CALL TGet
  2339. IF ZSubParm = -1 THEN _
  2340.  EXIT SUB                              'Pe 05/24/89
  2341.       ZWasB = 1                                                            'DMOD1
  2342.        IF ZWasQ = 0 THEN _                                                  'DMOD1
  2343.         GOTO 60140              'Pe 05/24/89 was Exit Sub
  2344. IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
  2345.    CALL BufFile (ZArcWork$,WasX) : _
  2346. GOTO 60149
  2347.        LastArc = ZWasQ                                                 'DMOD1
  2348.        FirstArc =ZWasB                                                    'DMOD1
  2349. '
  2350. FOR ArcIndex = FirstArc TO LastArc                            'DMOD1
  2351. WasZ$ = ZUserIn$(ArcIndex)                                                'DMOD1
  2352.    CALL AllCaps (WasZ$)  
  2353.   IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
  2354.     CALL QuickTPut ("Sorry, but Wildcards are NOT allowed !!",1) : _   ' Bh
  2355.      GOTO 60149                                           'PEMOD1
  2356.  CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)                        'DMOD1
  2357.  IF Ext$ = "ARC" OR Ext$ = "COM" OR Ext$ = "EXE" OR Ext$ = "BAS" OR _   'DMOD1
  2358.          Ext$ = "BIN" OR Ext$ = "LIB" OR Ext$ = "OBJ" OR Ext$ = "PIC" THEN _ 
  2359.          CALL QuickTPut ("Sorry, but only text files can be displayed",1) :_      'DMOD1  ' Bh
  2360.          GOTO 60149                                                     'DMOD1
  2361.       CALL QuickTPut (" Extracting file....",1)    'DMOD1
  2362. '
  2363. '
  2364. ' ******* Next 3 lines added for ZIP support    Pe 02/19/89
  2365. IF ZLastExt$ = "ZIP" THEN _
  2366.  SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
  2367. GOTO 60150 _
  2368. ELSE IF ZLastExt$ = "LZH" THEN _
  2369.  SHOWME$ = ZLibArcPath$+"VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
  2370.   GOTO 60150
  2371. '
  2372.  IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
  2373.       SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$
  2374.  IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
  2375.       SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ + " /R"
  2376.  IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
  2377.  SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " "+ ZArkViewPath$+WasZ$
  2378. 60150 SHOWME$ = "COMMAND.COM /C "+SHOWME$   'Pe 09/20/89
  2379.       SHELL SHOWME$                                         'Pe 02/19/89
  2380.       WasZ$ = ZArkViewPath$ + WasZ$      'Pe 09/23/89
  2381.       Temp$ = WasZ$
  2382. CALL FindIt (WasZ$)
  2383.         IF NOT ZOK THEN _
  2384.          CALL QuickTPut(CHR$(7)+WasZ$+" ISN'T HERE or perhaps you misspelled",1) :_  ' Bh
  2385.         GOTO 60149
  2386.       CALL BufFile (WasZ$,WasX)                                             'DMOD1
  2387.       CALL KillWork(Temp$)   'get rid of the files that were xtracted   PEMOD1
  2388.        NEXT ArcIndex
  2389. GOTO 60140
  2390. '
  2391. 60168 ZSubParm = 1
  2392.       CALL SkipLine (1)
  2393. 60169  ZOutTxt$ = "Which file(s) to Extract, R)elist or [RETURN] to quit"  ' Bh
  2394.     CALL TGet
  2395. IF ZSubParm = -1 OR ZWasQ = 0 THEN _      'Pe 02/12/90
  2396.    EXIT SUB                              'Pe 02/12/90
  2397. IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
  2398.    CALL BufFile (ZArcWork$,WasX) : _
  2399.    GOTO 60168
  2400.      ZwasB = 1                                                            'DMOD1
  2401.      LastArc = ZwasQ                                                    'DMOD1
  2402.      FirstArc = ZwasB                                                   'DMOD1
  2403.  FOR ArcIndex = FirstArc TO LastArc                           'DMOD1
  2404.  WasZ$ = ZUserIn$(ArcIndex)                                                   'DMOD1
  2405.      CALL AllCaps (WasZ$)
  2406.      CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)                        'DMOD1
  2407.      CALL SkipLine (2)
  2408.      CALL QuickTPut ("Please stand by, extracting file(s)....",1)    'DMOD1
  2409. '
  2410. 'Next 3 lines for ZIP Support Pe 02/19/89
  2411. '
  2412. IF ZLastExt$ = "ZIP" THEN _
  2413.  SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
  2414. GOTO 60170 _
  2415. ELSE IF ZLastExt$ = "LZH" THEN _
  2416.  SHOWME$ = ZLibArcPath$+ "VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
  2417.  GOTO 60170
  2418.  
  2419. '
  2420. '
  2421.  IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
  2422.       SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$
  2423.  IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
  2424.       SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$+" /R"
  2425.  IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
  2426.       SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " " + ZArkViewPath$ + "\" +WasZ$
  2427. '
  2428. 60170 SHOWME$ = "COMMAND.COM /C "+ SHOWME$
  2429.  SHELL SHOWME$     'Added line Number Pe 02/19/89
  2430. LOOKFOR$ = ZArkViewPath$ + WasZ$  'Pe 09/23/89
  2431. CALL FindIt(LOOKFOR$)
  2432.      IF NOT ZOK THEN _
  2433. CALL QuickTPut ("Error extracting " + WasZ$ + "...file Skipped...",2) : _
  2434.       GOTO 60171
  2435.        CALL QuickTPut (WasZ$+" Is now  Extracted ...",2)
  2436. 60171 NEXT ArcIndex
  2437. CALL QuickTPut ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
  2438. GOTO 60140
  2439. '
  2440. ' ***  Added choice of Compressing file or taking it as is Pe 03/23/89 ***
  2441. '
  2442. 60175 ZSubparm = 1          'Pe 02/12/90
  2443.       ZOutTxt$ = ZCrLf$ +"List files about to be Compressed (Y/[N])"
  2444.       ZTurboKey = -ZTurboKeyUser        'Pe 02/12/90
  2445.        CALL TGet
  2446.        CALL AllCaps (ZUserIn$)        'Pe 02/12/90    
  2447. IF ZSubParm = -1 THEN _      'Pe 03/29/88
  2448.    EXIT SUB                              'Pe 03/29/88
  2449. IF ZWasQ = 0 OR ZUserIn$ ="N" Then _            'Pe 02/12/90
  2450.    GOTO 60179                            'pe 04/07/89
  2451. IF ZUserIn$ = "Y" THEN _           'Pe 03/29/89
  2452.  CALL QuickTPut ("Creating file list, one moment please....",1): _
  2453.    EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" : _
  2454.    SHELL EXTRACT$ : _
  2455. CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX) : _
  2456. ZSubParm = 1 : _         'Pe 03/26/89
  2457.  ZOutTxt$ = ZCrLf$ +"Continue with file Compression ([Y]/N) " : _
  2458. ZTurboKey = -ZTurboKeyUser : _            'Pe 02/12/90
  2459.     CALL TGet : _
  2460. IF ZSubParm = -1 THEN _      'Pe 03/29/88
  2461.    EXIT SUB   : _                              'Pe 03/29/88
  2462. IF ZUserIn$ = "N" or ZUserIn$ = "n" THEN _           'Pe 03/29/89
  2463.  GOTO 60140 : _
  2464.  CALL QuickTPut ("One Moment Compressing file(s)........",1)
  2465. '
  2466. '********** ZIP all files in the ZArkViewPath$ into VIEW.ZIP **********
  2467. '
  2468. '60179  ZIPME$ = ZLibArcPath$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
  2469. 60179  ZIPME$ = ZLibArcPath$+"PKZIP -m -ex " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
  2470. '
  2471. If ZLocalUser THEN _
  2472. SHELL ZIPME$ _
  2473. ELSE  ZIP$ = "VUZIP"+ZNodeID$+".BAT": _
  2474.           CALL OpenOutW (ZIP$) : _
  2475.           PRINT #2, "ECHO OFF" : _
  2476.           PRINT #2, "CTTY GATE"+RIGHT$(ZComPort$,1) : _
  2477.           PRINT #2, ZIPME$ : _
  2478.           PRINT #2, "CTTY CON" : _
  2479.           PRINT #2, "ECHO ON" : _
  2480.           PRINT #2, "EXIT": _
  2481. CALL ShellExit (ZIP$)
  2482. 'SHELL ZIPME$
  2483. '
  2484. ' **** Check to see if Compresion was successfull if NOT then redo *****
  2485. ViewFileName$ = ZArkViewPath$ + "VIEW.ZIP"   'Pe 09/23/89 removed
  2486. CALL FindIt (ViewFileName$)
  2487. IF NOT ZOK THEN _
  2488. CALL QuickTPut ( "No files to Compress...you must use the X)tract command first" ,2) : _
  2489. CALL DelayTime (2) : _
  2490. GOTO 60140
  2491. '
  2492. '
  2493. '********** Tells the caller the name of the file to download **********
  2494. '
  2495. CALL QuickTPut (" File has been Compressed and named... VIEW.ZIP....",2)
  2496. CALL QuickTPut (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
  2497. CALL DelayTime (3)
  2498. GOTO 60140
  2499. 60180 END SUB
  2500. '
  2501. '
  2502. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  2503. '  $PAGE
  2504. '
  2505. '
  2506. ' Error handling for the separately compiled subroutines of RBBS-PC
  2507. '
  2508. '
  2509. 65000 IF ZDebug THEN _
  2510.          ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  2511.               STR$(ERL) + _
  2512.               " ERR=" + _
  2513.               STR$(ERR) : _
  2514.          IF ZPrinter THEN _
  2515.             CALL Printit(ZOutTxt$) _
  2516.          ELSE CALL LPrnt(ZOutTxt$,1)
  2517.       ZErrCode = ERR
  2518. '
  2519. '     SetCall
  2520. '
  2521.       IF ERL = 110 THEN _
  2522.           RESUME NEXT
  2523. '
  2524. '     OPEN CONFIG FILE
  2525. '
  2526.        IF ERL => 117 AND ERL <= 119 THEN _
  2527.           RESUME NEXT
  2528. '
  2529. '     OPEN COM PORT ERROR HANDLING
  2530. '
  2531.       IF ERL = 200 THEN _
  2532.          CLS : _
  2533.          CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
  2534.          STOP
  2535. '
  2536. '     GetCom ERROR HANDLING
  2537. '
  2538.        IF ERL = 1420 AND ERR = 57 THEN _
  2539.           RESUME NEXT
  2540.        IF ERL = 1420 AND ERR = 69 THEN _
  2541.           ZSubParm = -1 :_
  2542.           RESUME NEXT
  2543. '
  2544. '      OPENRESEQ ERROR HANDLING
  2545. '
  2546.        IF ERL = 1481 THEN _
  2547.            ZErrCode = ERR : _
  2548.            RESUME NEXT
  2549. '
  2550. '      OpenUser ERROR HANDLING
  2551. '
  2552.        IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
  2553.           CALL DelayTime (30) : _
  2554.           RESUME
  2555. '
  2556. '      FindUser ERROR HANDLING
  2557. '
  2558.        IF ERL = 12610 THEN _
  2559.           RESUME NEXT
  2560. '
  2561. '     UpdtCalr ERROR HANDLING
  2562. '
  2563.        IF ERL = 13663 THEN _
  2564.           RESUME NEXT
  2565.        IF ERL = 13672 AND ERR = 61 THEN _
  2566.           CALL QuickTPut1 ("Disk Full") : _
  2567.           IF ZDiskFullGoOffline THEN _
  2568.              GOTO 65010 _
  2569.           ELSE RESUME NEXT
  2570.        IF ERL = 13672 THEN _
  2571.           ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
  2572.           RESUME NEXT
  2573. '
  2574. '     ZPrinter ERROR HANDLING
  2575. '
  2576.        IF ERL = 13674 THEN _
  2577.           ZPrinter = ZFalse : _
  2578.           RESUME
  2579. '
  2580. '      ChangeDir ERROR HANDLING
  2581. '
  2582.        IF ERL = 20103 THEN _
  2583.           ZOK = ZFalse : _
  2584.           RESUME NEXT
  2585. '
  2586. '     FindIt ERROR HANDLING
  2587. '
  2588.        IF ERL = 20221 THEN _
  2589.           RESUME NEXT
  2590.        IF ERL = 20223 AND ZErrCode = 58 THEN _
  2591.           ZErrCode = 64 : _
  2592.           ZOK = ZFalse : _
  2593.           RESUME NEXT
  2594.        IF ERL = 20223 AND ZErrCode = 76 THEN _
  2595.           CALL LPrnt("Bad path.  File name is " + FilName$,1) : _
  2596.           ZErrCode = 76 : _
  2597.           ZOK = ZFalse : _
  2598.           RESUME NEXT
  2599.        IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
  2600.           AND ZNetworkType = 6 THEN _
  2601.              ZErrCode = 0 : _
  2602.              RESUME NEXT
  2603.        IF ERL => 20221 AND ERL <= 20223 THEN _
  2604.           RESUME
  2605. '
  2606. '     FlushCom ERROR HANDLING
  2607. '
  2608.        IF ERL = 20310 AND ERR = 14 THEN _       'Pe 01/03/90
  2609.           RESUME NEXT                           'Pe 01/03/90
  2610.        IF ERL = 20311 AND ERR = 57 THEN _
  2611.           RESUME NEXT
  2612.        IF ERL = 20311 AND ERR = 69 THEN _
  2613.           ZAbort = ZTrue : _
  2614.           ZSubParm = -1 : _
  2615.           RESUME NEXT
  2616. '
  2617. '     FileLock ERROR HANDLER       'Pe 11/20/89
  2618. '
  2619.       IF ERL => 21995 AND ERL <= 29830 THEN _   'Pe 11/20/89
  2620.        RESUME NEXT                              'PE 11/20/89
  2621. '
  2622. '     NetBIOS ERROR HANDLING
  2623. '
  2624.        IF ERL => 29900 AND ERL <= 29920 THEN _
  2625.           RESUME NEXT
  2626. '
  2627. '     UpdateC ERROR HANDLING
  2628. '
  2629.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  2630.          ZOutTxt$ = "* Disk full - terminating *" : _
  2631.          ZSubParm =2 : _
  2632.          CALL TPut : _
  2633.          IF ZDiskFullGoOffline THEN _
  2634.            GOTO 65010 _
  2635.          ELSE SYSTEM
  2636. '
  2637. '     CheckInt ERROR HANDLING
  2638. '
  2639.        IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
  2640.           ZNotCTS = ZTrue : _
  2641.           CALL Line25 : _
  2642.           ZErrCode = 0 : _
  2643.           RESUME
  2644.        IF ERL => 52000 AND ERL <= 59725 THEN _
  2645.           RESUME NEXT
  2646. '
  2647. '     FindFile ERROR HANDLING
  2648. '
  2649.        IF ERL = 59791 THEN _                                         ' KG012802
  2650.           IF ERR = 57 THEN _                                         ' AC012601
  2651.              CALL DelayTime (1) : _                                  ' AC012601
  2652.              CALL UpdtCalr ("SLOW I/O ERROR",1) : _                  ' AC012601
  2653.              IOErrorCount = IOErrorCount + 1 : _                     ' AC012601
  2654.              IF IOErrorCount < 11 THEN _                             ' AC012601
  2655.                 RESUME                                               ' AC012601
  2656. '
  2657. '     Chat Door Error handleing
  2658. '
  2659. '     IF (ERL = 59800 OR ERL = 59810) AND ERR = 70 THEN             'Pe 02/27/90
  2660. '          RESUME
  2661. '       END IF
  2662. '
  2663. '      VIEW ARC TXT ERROR HANDLER
  2664. '
  2665.  IF ERL = 60149 AND ERR = 53 THEN _
  2666.          CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
  2667.          RESUME NEXT
  2668. IF ERL = 60149 AND ERR = 63 THEN _
  2669.          CALL QuickTPut ("ERROR Occured, Please notify SysOp",1):_
  2670.          RESUME NEXT
  2671. '
  2672. '
  2673. '      DLVIEW ARC TXT ERROR HANDLER 
  2674. '
  2675.  IF ERL = 60170 AND ERR = 53 THEN _
  2676.          CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
  2677.          RESUME NEXT
  2678. '
  2679. '
  2680. '
  2681. '     CATCH ALL OTHER ERRORS
  2682. '
  2683.        ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
  2684.             STR$(ERR) + _
  2685.             " in line" + _
  2686.             STR$(ERL)
  2687.        CALL QuickTPut1 (ZOutTxt$)
  2688.        CALL UpdtCalr (ZOutTxt$,2)
  2689.        RESUME NEXT
  2690. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  2691. 65010  CALL OpenCom(ZModemInitBaud$,",N,8,1")
  2692.        CALL TakeOffHook
  2693.        SYSTEM
  2694.